VBA If Заявление для извлечения данных из другой рабочей книги - PullRequest
Новая
       10

VBA If Заявление для извлечения данных из другой рабочей книги

0 голосов
/ 11 мая 2018

У меня проблема.Я пытаюсь получить данные из одной рабочей книги в другую.Я успешно сделал это, однако мне нужно получить информацию, если кулон C рабочей книги 1 соответствует кулуну A рабочей тетради 2, а если кулон D рабочей книги 1 соответствует кулону B рабочей книги 2. Затем вытащите Coulmn B из рабочей книги 1 в кулон Dкниги 2. Я нахожусь на Windows 10 с Excel 2016. Любая помощь приветствуется

Это код сейчас. 

    Sub AmandaTest()
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim vFile As Variant

'Set source workbook
Set wbTarget = ThisWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If vFile = "" Then Exit Sub
'Set targetworkbook
Set wbSource = Workbooks.Open(vFile)
'Set Sheets for both Source & Target Workbooks
Set wsS = wbTarget.Sheets("MainPage")
Set wsT = wbSource.Sheets("Sheet1")
'get the last row with data from both Sheets into variables
LastRowT = wsS.Cells(wsT.Rows.Count, "A").End(xlUp).Row
LastRowS = wsT.Cells(wsS.Rows.Count, "A").End(xlUp).Row

'For instance, copy data from a range in the first workbook to another range in the other workbook
For i = 1 To LastRowT 'loop from row 1 to last on Sheet Target
    For x = 1 To LastRowS 'loop from row 1 to last on Sheet Source
        If wsT.Range("C" & i).Value = wsS.Range("C" & x).Value Then
        'if value from Column C in Target equals any value from Column C in Source then
            If wsT.Range("B" & i).Value = wsS.Range("D" & x).Value Then
            'if value from Column B in Target equals value from Column D on Sheet Source then
                wsT.Range("D" & i).Value = wsS.Range("B" & x).Value 'pass values into Target Sheet
            End If
        End If
    Next x
Next i

End Sub

Ответы [ 2 ]

0 голосов
/ 14 мая 2018 
 This is the code that works, if you notice the original code had coulmn "C" on it, but this has coulmn "A". That's because I was checking the wrong row. Thank you so much for your help @Xabier


   Sub AmandaTest()
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim vFile As Variant

'Set source workbook
Set wbTarget = ThisWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If vFile = "" Then Exit Sub
'Set targetworkbook
Set wbSource = Workbooks.Open(vFile)
'Set Sheets for both Source & Target Workbooks
Set wsS = wbTarget.Sheets("MainPage")
Set wsT = wbSource.Sheets("Sheet1")
'get the last row with data from both Sheets into variables
LastRowS = wsS.Cells(wsT.Rows.Count, "A").End(xlUp).Row
LastRowT = wsT.Cells(wsS.Rows.Count, "A").End(xlUp).Row

'For instance, copy data from a range in the first workbook to another range in the other workbook
For i = 1 To LastRowS 'loop from row 1 to last on Sheet Target
    For x = 1 To LastRowT 'loop from row 1 to last on Sheet Source
        If wsS.Range("A" & i).Value = wsT.Range("C" & x).Value Then
        'if value from Column C in Target equals any value from Column C in Source then
            If wsS.Range("B" & i).Value = wsT.Range("D" & x).Value Then
            'if value from Column B in Target equals value from Column D on Sheet Source then
                wsS.Range("D" & i).Value = wsT.Range("B" & x).Value 'pass values into Target Sheet
            End If
        End If
    Next x
Next i

End Sub

0 голосов
/ 14 мая 2018

Я полагаю, что следующий код поможет вам понять, как сделать то, что вы хотите достичь, я использовал двойной цикл, чтобы перейти от строки 1 к последней в целевой таблице для сравнения со значениями в исходном листе, а затем передать Значения по мере необходимости: 

Sub AmandaTest()
Dim wbSource As Workbook, wbTarget As Workbook
Dim wsS As Worksheet, wsT As Worksheet
Dim vFile As Variant

'Set source workbook
Set wbSource = ThisWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If vFile = "" Then Exit Sub
'Set targetworkbook
Set wbTarget = Workbooks.Open(vFile)
'Set Sheets for both Source & Target Workbooks
Set wsS = wbSource.Sheets("Sheet1")
Set wsT = wbTarget.Sheets("Sheet1")
'get the last row with data from both Sheets into variables
LastRowT = wsT.Cells(wsT.Rows.Count, "A").End(xlUp).Row
LastRowS = wsS.Cells(wsS.Rows.Count, "A").End(xlUp).Row

'For instance, copy data from a range in the first workbook to another range in the other workbook
For i = 1 To LastRowT 'loop from row 1 to last on Sheet Target
    For x = 1 To LastRowS 'loop from row 1 to last on Sheet Source
        If wsT.Range("C" & i).Value = wsS.Range("C" & x).Value And wsT.Range("B" & i).Value = wsS.Range("D" & x).Value Then
        'if C = C and B = D then
                wsT.Range("D" & i).Value = wsS.Range("B" & x).Value 'pass values into Target Sheet
        End If
    Next x
Next i
End Sub
...