• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücredeki veri yığınını başka bir sayfaya anlamlı olarak aktarmak

  • Konbuyu başlatan Konbuyu başlatan hsayar
  • Başlangıç tarihi Başlangıç tarihi
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Sayfa1. f38 hücresinin görüntüsü aşağıdaki gibidir.
<OPTION value=""></OPTION><OPTION value="89882">ABDURRAHMAN MAH.</OPTION><OPTION value="121382">AHI KÖYÜ</OPTION><OPTION value="89912">AVARIZ KÖYÜ</OPTION><OPTION value="89883">BABADEMİRTAŞ MAH.</OPTION><OPTION value="89884">BARUTLUK MAH.</OPTION><OPTION value="89913">BOSNA KÖYÜ</OPTION><OPTION value="121383">BUDAKDOĞANCA KÖYÜ</OPTION><OPTION value="89914">BÜYÜKDÖLLÜK KÖYÜ</OPTION><OPTION value="121384">BÜYÜKİSMAİLÇE KÖYÜ</OPTION><OPTION value="89908">ÇAVUŞBEY MAH.</OPTION><OPTION value="89915">DEĞİRMENYENİ KÖYÜ</OPTION><OPTION value="89916">DEMİRHANLI KÖYÜ</OPTION><OPTION value="89886">DİLAVERBEY MAH.</OPTION><OPTION value="76216">DOYRAN KÖYÜ</OPTION><OPTION value="121385">EKMEKÇİ KÖYÜ</OPTION><OPTION value="76217">ELÇİLİ KÖYÜ</OPTION><OPTION value="89917">ESKİKADIN KÖYÜ</OPTION><OPTION value="89887">FATİH MAH.</OPTION><OPTION value="89918">HACIUMUR KÖYÜ</OPTION><OPTION value="89919">HASANAĞA KÖYÜ</OPTION><OPTION value="89920">HATİP KÖYÜ</OPTION><OPTION value="89921">HIDIRAĞA KÖYÜ</OPTION><OPTION value="89922">İSKENDER KÖYÜ</OPTION><OPTION value="89910">İSTASYON MAH.</OPTION><OPTION value="89889">KARAAĞAÇ MAH.</OPTION><OPTION value="121386">KARABULUT KÖYÜ</OPTION><OPTION value="76215">KARAKASIM B.M KÖYÜ</OPTION><OPTION value="89923">KARAYUSUF KÖYÜ</OPTION><OPTION value="89924">KAYAPA KÖYÜ</OPTION><OPTION value="121387">KEMAL KÖYÜ</OPTION><OPTION value="89890">KOCA SİNAN MAH.</OPTION><OPTION value="89925">KORUCU KÖYÜ</OPTION><OPTION value="89926">KÖŞENÇİFTLİĞİ KÖYÜ</OPTION><OPTION value="89927">KÜÇÜKDÖLLÜK KÖYÜ</OPTION><OPTION value="89891">MEDRESE ALİ BEY MAH.</OPTION><OPTION value="89928">MENEKŞESOFULAR KÖYÜ</OPTION><OPTION value="89892">MENZİLAHIR MAH.</OPTION><OPTION value="89893">MEYDAN MAH.</OPTION><OPTION value="89894">MİTHAT PAŞA MAH.</OPTION><OPTION value="89929">MURATÇALI KÖYÜ</OPTION><OPTION value="89930">MUSABEYLİ KÖYÜ</OPTION><OPTION value="89895">NİŞANCIPAŞA MAH.</OPTION><OPTION value="76218">ORHANİYE KÖYÜ</OPTION><OPTION value="89897">SABUNİ MAH.</OPTION><OPTION value="121381">SARAYAKPINAR B.M KÖYÜ</OPTION><OPTION value="89898">SARICAPAŞA MAH.</OPTION><OPTION value="89931">SAZLIDERE KÖYÜ</OPTION><OPTION value="89932">SUAKACAĞI KÖYÜ</OPTION><OPTION value="89911">ŞÜKRÜPAŞA MAH.</OPTION><OPTION value="89900">TALATPAŞA MAH.</OPTION><OPTION value="76219">TAYAKADIN KÖYÜ</OPTION><OPTION value="89901">UMURBEY MAH.</OPTION><OPTION value="121388">UZGAÇ KÖYÜ</OPTION><OPTION value="76220">ÜYÜKLÜTATAR KÖYÜ</OPTION><OPTION value="89903">YANCIKÇI ŞAHİN MAH.</OPTION><OPTION value="89904">YENİİMARET MAH.</OPTION><OPTION value="89933">YENİKADIN KÖYÜ</OPTION><OPTION value="89906">YILDIRIM BEYAZIT MAH.</OPTION><OPTION value="89907">YILDIRIM HACI SARRAF MAH.</OPTION><OPTION value="89934">YOLÜSTÜ KÖYÜ</OPTION><OPTION value="89881">1.MURAT MAH.</OPTION>

bu verileri sayfa2. f(ilkboşsatır) ve g(ilkboşsatır) dan başlayarak aşağıdaki gibi yazdırabilirmiyiz?
Kod:
89882     ABDURRAHMAN MAH.
121382   AHI KÖYÜ
...
 
;"";76843"KIRCASALİH-BALABAN MAH.;76844"KIRCASALİH-CUMHURİYET MAH.;76846"KIRCASALİH-İSTİKLAL MAH.;76845"KIRCASALİH-OKULLAR MAH.;

değiştiriyorum verileri biraz daha anlamlı kıldım. ;xxxx; arasındaki veriyi yeni sayfaya sıralı aktarabilmemiz yeterli.

makro çalıştıktan sonra veri f sütununda ilk boş satırdan başlıyarak sıralı olarak aşağıdaki gibi yer almalıdır;

""
76843"KIRCASALİH-BALABAN MAH.
76844"KIRCASALİH-CUMHURİYET MAH.
76846"KIRCASALİH-İSTİKLAL MAH.
76845"KIRCASALİH-OKULLAR MAH.


Tabi hazır elim değmişken şöylede yapabilirim diyene hayır demem :) f sütununa rakamlar, g sütununa değerler, "" çift tırnak ise rakam yok, değer <TANIMSIZ>

....... <tanımsız>
76843 KIRCASALİH-BALABAN MAH.
76844 KIRCASALİH-CUMHURİYET MAH.
76846 KIRCASALİH-İSTİKLAL MAH.
76845 KIRCASALİH-OKULLAR MAH.
 
Son düzenleme:
benim beyinde bugünlerde motor gibi çalışıyor, kısa devre yapmış :) Soğuyunca üzeldi, çözümü paylaşayım bari;
baş ve sondak noktalı virgülleri aşamadım düzelttikten sonra istediğimi elde ettim.

Kod:
      Sub hücreyiparçalaveaktar()
        'Hüseyin Sayar, Kaynak sayfadaki verileri Sonuc sayfasına aktar.
        Dim wksVERI     As Excel.Worksheet
        Dim wksSNUC     As Excel.Worksheet
        Dim arrMuhtlar
        Dim arrMuhtAyr
        Dim sIL         As String
        Dim sILCE       As String
        Dim sBELDE      As String
        Dim lsonsatV    As Long
        Dim lsonsatS    As Long
        Dim i           As Integer
        Dim j           As Integer

        Set wksVERI = ThisWorkbook.Worksheets("Veri")
        Set wksSNUC = ThisWorkbook.Worksheets("Sonuc")

        lsonsatV = wksVERI.Cells(65536, "F").End(3).Row
        lsonsatS = wksSNUC.Cells(65536, "F").End(3).Row + 1
        
        For i = 2 To lsonsatV
          With wksVERI
            sIL = .Cells(i, "C")
            sILCE = .Cells(i, "D")
            sBELDE = .Cells(i, "E")
            arrMuhtlar = Split(.Cells(i, "F"), ";")
          End With
          
          For j = LBound(arrMuhtlar) To UBound(arrMuhtlar)
            With wksSNUC
              .Cells(lsonsatS, "C") = sIL
              .Cells(lsonsatS, "D") = sILCE
              .Cells(lsonsatS, "E") = sBELDE
              arrMuhtAyr = Split(arrMuhtlar(j), Chr(34))
              If IsNumeric(arrMuhtAyr(0)) = True Then
                .Cells(lsonsatS, "F") = arrMuhtAyr(0)
                .Cells(lsonsatS, "G") = arrMuhtAyr(1)
              Else
                .Cells(lsonsatS, "G") = "<TANIMSIZ>"
              End If
              lsonsatS = lsonsatS + 1
              Erase arrMuhtAyr
            End With
          Next j
          
          Erase arrMuhtlar
       Next i

       Set wksVERI = Nothing
       Set wksSNUC = Nothing
      End Sub
 
Geri
Üst