Soru Excel dosyasını seçerek veri getirme

[nunu446]

Merhaba. Aşağıdaki nümune isimli dosyaya dosya seçerek istanbul ve izmir isimli dosyadan makro yardımıyla bina numaralarına uygun tutarları getirib nümune isimli dosyada B sütununda bina numarasının karşısına veri getirilmesini istiyorum. Yardımcı olacak biri umarım olucaktır. Önceden teşekkürler.

 

[nunu446]

Merhaba. Aşağıdaki nümune isimli dosyaya dosya seçerek istanbul ve izmir isimli dosyadan makro yardımıyla bina numaralarına uygun tutarları getirib nümune isimli dosyada B sütununda bina numarasının karşısına veri getirilmesini istiyorum. Yardımcı olacak biri umarım olucaktır. Önceden teşekkürler.

İndir İstanbul

Dosyayı indir İstanbul

dosya.co

İndir İzmir

Dosyayı indir İzmir

dosya.co

İndir nümune

Dosyayı indir nümune

dosya.co

 

[nunu446]

İndir İstanbul

Dosyayı indir İstanbul

dosya.co

İndir İzmir

Dosyayı indir İzmir

dosya.co

İndir nümune

Dosyayı indir nümune

dosya.co

Sub getir()
Dim dzNum As Variant
Dim dzIst As Variant
Dim dzIzm As Variant
Dim son As Integer, sonIst As Integer, sonIzm As Integer, i As Integer, j As Integer, k As Integer, a As Integer
Dim yol As String
yol = ThisWorkbook.Path & Application.PathSeparator
Dim wb As Workbook
Dim ws As Worksheet

With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
End With
    
Set wb = Workbooks.Open(Filename:=yol & "İstanbul.xlsx")
wb.Activate
Set ws = wb.Worksheets("TOTAL")
sonIst = ws.Cells(Rows.Count, 1).End(xlUp).Row
dzIst = ws.Range("A3:E" & sonIst)
wb.Close

Set wb = Workbooks.Open(Filename:=yol & "İzmir.xlsx")
wb.Activate
Set ws = wb.Worksheets("TOTAL")
sonIzm = ws.Cells(Rows.Count, 1).End(xlUp).Row
dzIzm = ws.Range("A3:E" & sonIzm)
wb.Close
Set ws = ThisWorkbook.Sheets("Bina")
son = ws.Cells(Rows.Count, 3).End(xlUp).Row
dzNum = ws.Range("A5:C" & son)
    For k = 1 To UBound(dzNum, 1)
        If dzNum(k, 1) <> "" Then
        a = dzNum(k, 1)
        Else
        dzNum(k, 1) = a
        End If
    Next k


  For k = 1 To UBound(dzNum, 1)
        For i = 1 To UBound(dzIst, 1) - 2
'        Debug.Print dzIst(i, 1)
            If dzNum(k, 3) = "İstanbul" And dzNum(k, 1) = CInt(Right(dzIst(i, 1), (Len(dzIst(i, 1)) - 7))) Then
            dzNum(k, 2) = dzIst(i, 5)
            Exit For
            End If
        Next i
        For j = 1 To UBound(dzIzm, 1) - 2
        If dzNum(k, 3) = "İzmir" And dzNum(k, 1) = CInt(Right(dzIzm(j, 1), (Len(dzIzm(j, 1)) - 7))) Then
            dzNum(k, 2) = dzIzm(j, 5)
            Exit For
         End If
        Next j
  Next k
  For k = 1 To UBound(dzNum, 1)
  ws.Cells(k + 4, 2) = dzNum(k, 2)
  Next k
  With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
   End With
End Sub

Şöyle bir kod var elimde, ancaq şu kod ismi yazılan dosyalardan veri getiriyo, ama ben kodu çalıştırdığım zaman dosyayı benim seçmemi istiyorum, o yüzden aşağıdaki kodu nereye eklemem lazım?

Dim yol As String
yol = vaFiles = Application.GetOpenFilename( _
    FileFilter:="Microsoft Excel Workbooks(*.xls;*.xlsx;*.xlsb;*.xlsm),*.xls;*.xls;*.xlsx;*.xlsb;*.xlsm", _
    Title:="Select Files to Proceed", MultiSelect:=True)

 

[Korhan Ayhan]

Linkteki mantığı irdeleyebilirsiniz.

Kapalı Dosyadan veri alırken üzerine ekleme

Merhaba arkadaşlar, Siteden araştırarak ekli dosyamdaki kod ile kapalı dosyadan istediğim verileri alıyorum, ancak bunu bir dosyadan alabiliyorum. Benim istediğim, aynı formatta olan ve diğer dosyalardan da isteğime göre verileri almak istiyorum, yani kodu her çalıştırdığımda eski verilerin...

www.excel.web.tr

Yetersiz gelirse diğer konulardan faydalanabilirsiniz.

Arama Sonuçları