İsmi değişken excelden veri çekme Hk.

[yunusemre16]

Merhaba,

Yıllar önce bu sorunum hakkında yine buradan cevap almıştım. @veyselemre bey'in yazdığı çok güzel bir makro ile sorunumu çözebiliyorum.

İsmi değişken excelden veri çekiyorum. Bu çektiğim verileri başka bir excele aktarıyorum. Makro bilgim olmadığı için tek tek formül girerek yapabiliyorum.

Öğrenmek istediğim aşağıdaki makroda satır ve sütun numaralarını nasıl değiştirebilirim(Kusura bakmayın makro bilgim sıfır olduğu için neresi satır neresi sütun bilemedim)

Aşağıdaki makro da A sütunundan ürün adına bakıp, İkram ise B sütununa Satış ise C sütununa yazıyor. Benim yapmayı istediğim şey ise İkram ise E sütununa Satış ise F sütununa yazması. (E-F sütun isimleri örnek olarak yazdım, makroyu anlayabilmek benim için daha önemli)

Yardımcı olabilirseniz çok sevinirim

Sub adoRapor()
'veyselEMRE 07042019
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "C:\BiletiniAl\Reports\*Büfe*Rapor*.xls"
        If .Show = -1 Then fileopen = .SelectedItems(1)
    End With

    If fileopen = "" Then Exit Sub
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & fileopen & _
             "';Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"";"

    strsql = "SELECT [Stok Adı], IIF ([Ödeme Tipi]='Yönetim Misafir', [Satış Miktarı], NULL), " & _
             "IIF ([Ödeme Tipi]='Pesin', [Satış Miktarı], NULL) FROM [SHEET$5:1000] WHERE NOT [Ödeme Tipi] IS NULL"

    Set rs = CreateObject("Adodb.RecordSet")
    rs.Open strsql, strCon

    lst = rs.getrows

    With CreateObject("Scripting.Dictionary")
        Dim w(1 To 1, 1 To 2)
        For i = LBound(lst, 2) To UBound(lst, 2)
            If lst(0, i) <> "" Then ky = lst(0, i)
            If Not .exists(ky) Then .Item(ky) = w
            y = .Item(ky)
            If lst(1, i) <> "" Then y(1, 1) = lst(1, i)
            If lst(2, i) <> "" Then y(1, 2) = lst(2, i)
            .Item(ky) = y
        Next i
        son = Cells(Rows.Count, 1).End(3).Row
        Range("D2:G" & son).ClearContents
        For i = 2 To son
            ky = Cells(i, 1).Value
            If .exists(ky) Then
                Cells(i, 2).Resize(, 2).Value = .Item(ky)
                .Remove ky
            End If
        Next i
        If .Count > 0 Then
            kys = .keys
            itm = .items
            [H2].Value = "Hatalı Kayıtlar"
            For i = LBound(kys) To UBound(kys)
                Cells(i + 4, "H").Value = kys(i)
                Cells(i + 4, "I").Resize(, 2).Value = itm(i)
            Next i
        End If
    End With
      If MsgBox("...:İşlem Başarı ile Tamamlandı:..." & vbCrLf & vbCrLf _
& "Dosyayı Kaydedip ve Kapatmak istiyor musunuz ?", _
vbQuestion + vbYesNo, "İşlem Tamam - Dosya Kapatılsın mı ?") = vbNo Then Exit Sub
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[Cengiz Demir]

Örneğin Cells(i, 1) de i satır ref numarasını 1 ise sütun ref numarasını belirtiyor. Bu komut i değişkenine bağlı olarak A sütununun ilgili satırında işlem yapar. (i =5 ise A sütunu 5. satır)

Cells(i + 4, "H") bu da aynı şekilde fakat sütun ref nosu yerine sütun kodu belirtilmiş.

Range("D2:G" & son) Burda da alan belirtilmiş.
D2 hücresi ile G sütunun son değişkeni ile belirlenmiş alanları arasında işlem yapar.
(Örn. Son=20 ise D2 ve G20 aralığında)

 

[yunusemre16]

Çok teşekkür ederim, dün kurcalaya kurcalaya satırı değiştirebildim. Yinede çok teşekkür ederim ilginize