2016-09-29 5 views
1

도움이 되었기를 바랍니다. 아래에 몇 가지 코드를 작성했습니다. 기본적으로 Vlookup은 세 개의 열을 하나의 시트에 넣고 두 시트의 고유 식별자 Customer ID를 사용하여 다른 시트로 가져옵니다.Vlookup VBA에서 모든 정보를 가져 오지 못했습니다.

불행히도 Vlookup은 열 A 또는 B가 비어있을 때 Vlookup을 중지하는 것으로 보입니다. 이 문제를 방지하기 위해 코드를 수정할 수 있습니까? 코드에서 C 열을 사용하고 C 열을 사용해야하는 경우 C 열의 고유 식별자는 데이터의 끝까지 채워져 있습니다. 나는 더 나은 이해를 위해 사진을 첨부했고 코드는 아래에있다.

첫 번째 그림은 제 PIC 문제없이 enter image description here

이것에 vlookuped 열과 시트의 상부를 도시 I는 다음 시트 enter image description here

하게 할 열을 포함하는 시트를 도시 열 A와 B가 빈 될 때 VLOOKUP 여기 enter image description here

를 중지 지난 사진 쇼는 내 코드입니다 :

,536,913,632 10
Sub Add_consent() 

    'Definition of used variables 
    Dim Directory As String 'Directory for inputs and outputs 
    Dim Consent_folder As String 'Directory for inputs and outputs 
    Dim inputFile As String 'Input file name 
    Dim currentInput As String 'Input file name 
    Const DELIMITER As String = "|" 'Values delimiter 
    Dim OutputFile As String 'Output file name 
    Dim lngCount As Long 'selected files count 
    Dim wbkOutput As Workbook 'output workbook 
    Dim wbkTemp As Workbook 'temporary workbook 
    Dim myWkBook As Workbook 'Input Workbook 
    Dim Consent As Workbook 'Consent file 
    Dim Consent_name 'new opened file 
    Dim myWkSheet As Worksheet 'Input Worksheet 
    Dim sheetNum As Long 'Variable for sheet number 
    Dim sheetNames() As String 'output worksheet sheet names 
    Dim sheetInterfaceName 'Sheet name representing DID interface 
    Dim Active As Worksheet 'Active worksheet 
    Dim intLastRow As Long 'Last row element 
    Dim Error_Codes As Worksheet ' Sheet containing error codes 
    Dim myRecord As Range 'Record for output 
    Dim myField As Range 'Cell value for output 
    Dim nFileNum As Long 'Variable for file number 
    Dim sOut As String 'Text to be written into file 
    Dim invalidDelete As String 'Case of invalid delete attempt 
    Dim sheetIndex As Long ' Current sheet index 
    Dim Selected As Long ' 
    Dim rwCount As Long 'Number of current sheet rows containing data in tracking file 
    Dim colCount As Integer 'Number of current sheet columns containing data in tracking file 
    Dim extraCol As Integer 'Number of current sheet columns containing data in tracking file 
    Dim indexRow As Long 'Row index 
    Dim helpRow As Long ' 
    Dim AddIn As Integer 
    Dim selectedCount As Integer 
    Dim int1 As Long 
    Dim int2 As Integer 
    Dim int3 As Integer 

    'General application settings 
    Application.ScreenUpdating = False 'Turns off switching to exported excel file once it gets opened 
    Application.DisplayAlerts = False 'Turns off automatic alert messages 
    Application.EnableEvents = False ' 
    Application.AskToUpdateLinks = False 'Turns off the "update links" prompt 

    'User prompt, choose HCP file 
    MsgBox "Choose TOV file missing consent information" 

    'Alternative way to open the file 
    Dim fd As FileDialog 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    fd.AllowMultiSelect = False 

    'Assign a number for the selected file 
    Dim FileChosen As Integer 
    FileChosen = fd.Show 
    If FileChosen <> -1 Then 
    'Didn't choose anything (clicked on CANCEL) 
     MsgBox "No file selected - aborted" 
     End 'Ends file fetch and whole sub 
    End If 

    Dim fss As Object 
    Set fss = CreateObject("Scripting.FilesystemObject") 
    inputFile = Dir(fd.SelectedItems(1)) 'parses only the name of file 
    Directory = fss.getParentFolderName(fd.SelectedItems(1)) & "\" 'parses only directory of the file 

    'Open HCP file .xlsx spreadsheet 
    Set wbkTemp = Workbooks.Open(Filename:=Directory & inputFile) 
    'Set wbkTemp = Workbooks(Workbooks.Count) 

    'Get number of columns in the HCP file 
    colCount = wbkTemp.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column 

    'Get the number of rows in the HCP file 
    intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 

    'Set GCM_ID format to number 
    wbkTemp.Sheets(1).Range(wbkTemp.Sheets(1).Cells(2, 1), wbkTemp.Sheets(1).Cells(intLastRow, 1)).Select 'Specify the range which suits your purpose 
    With Selection 
     Selection.NumberFormat = "General" 
     .Value = .Value 
    End With 

    'Prompt user for the second file 
    MsgBox "Select file(s) containing Consent information" 

    'Open Consent file dialog 
    Dim filedial As FileDialog 
    Set filedial = Application.FileDialog(msoFileDialogOpen) 

    Dim chosen As Integer 
    chosen = filedial.Show 
    If chosen <> -1 Then 
    'Didn't choose anything (clicked on CANCEL) 
     MsgBox "No file selected - aborted" 
     End 'Ends file fetch and whole sub 
    End If 

    'Number of selected files 
    selectedCount = filedial.SelectedItems.Count 

    'Extra variable 
    AddIn = 0 

    For Selected = 1 To selectedCount 
    'Open file with Consent info 
    Consent_name = Dir(filedial.SelectedItems(Selected)) 
    'Consent_folder 
    Workbooks.OpenText Filename:=Consent_name, StartRow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|" 
    Set Consent = Workbooks(Workbooks.Count) 

    'Number of rows in consent file 
    rwCount = Consent.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row 

    'Specify the column to paste data 
    extraCol = colCount + AddIn + 1 

    '1) 
    'VLOOKUP across spreadsheets for consent data 
    'wbkTemp.Sheets(1).Cells(1, 1).Copy 
    'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats 
    'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent" 
    'With wbkTemp.Sheets(1) 
     '.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False) 
    'End With 

    '2) 
    'VLOOKUP across spreadsheets for consent data 
    'wbkTemp.Sheets(1).Cells(1, 1).Copy 
    'wbkTemp.Sheets(1).Cells(1, extraCol).PasteSpecial Paste:=xlPasteFormats 
    'wbkTemp.Sheets(1).Cells(1, extraCol).Value = "Consent" 
    'With wbkTemp.Sheets(1) 
    ' '.Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 1), .Cells(intLastRow, 1)).Value, Consent.Sheets(1).Range("B:J"), 8, False) 
    '  For int1 = 2 To intLastRow 
    '  if Application.WorksheetFunction.IsNA(Application.WorksheetFunction.VLookup(.Cells())) 
    ' 
    '  Next int1 
    'End With 

    '3) 
    'VLOOKUP across spreadsheets for consent data 
    With wbkTemp.Sheets(1) 
     .Cells(1, extraCol).Value = .Cells(1, 1).Value 
     .Cells(1, extraCol).Value = "Consent" 
     .Cells(1, extraCol + 2).Value = "Effective Date" 
     .Cells(1, extraCol + 3).Value = "End Date" 
     .Range(.Cells(2, extraCol), .Cells(intLastRow, extraCol)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:J"), 8, False) 
     .Range(.Cells(2, extraCol + 2), .Cells(intLastRow, extraCol + 2)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 12, False) 
     .Range(.Cells(2, extraCol + 2), .Cells(intLastRow, extraCol + 2)).NumberFormat = "dd/mm/yyyy" 
     .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).Value = Application.WorksheetFunction.VLookup(.Range(.Cells(2, 4), .Cells(intLastRow, 4)), Consent.Sheets(1).Range("B:N"), 13, False) 
     .Range(.Cells(2, extraCol + 3), .Cells(intLastRow, extraCol + 3)).NumberFormat = "dd/mm/yyyy" 
    End With 
    'Close the file with consent information 
    Consent.Close 

    'Loop again for next file 
    AddIn = AddIn + 1 
    Next Selected 

    'Deal with N/A values 
    With wbkTemp.Sheets(1) 
     For int1 = 2 To intLastRow 
      For int2 = 1 To selectedCount 
       If Not Application.WorksheetFunction.IsNA(.Cells(int1, colCount + int2).Value) Then 
        .Cells(int1, colCount + 1).Value = .Cells(int1, colCount + int2).Value 
       End If 
      Next int2 
     Next int1 
    End With 

    'Remove extra columns 
    With wbkTemp.Sheets(1) 
     .Columns(fnColumnToLetter_Split(colCount + 2) & ":" & fnColumnToLetter_Split(extraCol + selectedCount)).Delete Shift:=xlToLeft 
    End With 

    'Save and close the new workbook 
    With wbkTemp 
     'Save and close the new workbook 
     .SaveAs Filename:=inputFile 
     .Close True 
    End With 

    MsgBox "Available consent information added" 


End Sub 

Function fnColumnToLetter_Split(ByVal intColumnNumber As Integer) 
    fnColumnToLetter_Split = Split(Cells(1, intColumnNumber).Address, "$")(1) 
End Function 
+0

언뜻보기에 왜 멈추지 않을까요? 'intLastRow = wbkTemp.Sheets (1) .Cells (Rows.Count, 1) .End (xlUp) .Row'를 설정 했습니까? 'intLastRow' var에는 ** 열의 마지막으로 채워진 행인 ** 18,510 **의 값이 할당됩니다. – Jeeped

+0

나는 Jeeped와 동의합니다. 올바른 치수를 얻으려면 Worksheet.UsedRange 속성을 확인하십시오. –

+0

왜 'EXT_CUSTOMER_ID'라고하는 ** 고유 ID **를 사용하고 계십니까? 분명히 독특한 것은 아닙니다. 두 번째 이미지에는 처음 네 개의 데이터 행에 4 개의 ** 26950750 **이 있습니다. – Jeeped

답변

1

intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row 
'or ... 
intLastRow = wbkTemp.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row 

이 아닌 열 A

에서, intLastRow 에 열 D의 마지막 인구 행 번호를 넣어 것입니다, 당신이 intLastRow에 값의 할당을 변경해야합니다 보인다

는 또한 '다시 채움'누락 된 열 A 및 D

,691,363 열에서 '고유의 아이덴'를 사용하여 INDEX/MATCH 기능 쌍 B '이름'값을 고려해 볼 수 있습니다210
+0

부엉이 intLastRow = wbkTemp.Sheets (1) .Cells (행수 .4). 끝 (xlUp). 행운을 빕니다. 정말 감사드립니다. 정말 고마워요. 더블린으로부터의 존경심 :-) –

관련 문제