여러 행과 열에서 데이터를 연결하고 열을 삭제하는 방법은 무엇입니까?

Question

문자열 "Doc1"과 "Doc2"가 첫 번째 행 (머리글)의 모든 연속 된 열에 나타나는지 확인하기 위해 설계된 매크로가 있습니다.
그런 다음 매크로는 모든 후속 행에 대해 Doc1 열의 정보와 Doc2 열의 정보를 연결하고 응답을 쉼표로 구분해야합니다. 그런 다음 전체 Doc2 열을 삭제해야합니다.
내가 가진 코드를 통해 Doc1과 Doc2의 첫 번째 인스턴스가 나란히 작동합니다. 나머지 부분에서는 Doc1 상자에 정보를 연결하지 않고 단순히 Doc2 열을 삭제합니다. 이것에 대한 도움은 크게 감사 할 것입니다. 여기

는 코드입니다 :

Sub test() 

Dim CurrCol As Integer 
Dim NewValue As String 
Dim CurrRow As Integer 

CurrCol = 1 
RowNum = 1 

'set last cell 
While Cells(1, CurrCol).Address <> "$HOK$1" 

    'MsgBox Cells(1, CurrCol).Address & " " & Cells(1, CurrCol).Value 

     If InStr(Cells(1, CurrCol).Value, "Doc1") > 0 Then 
      ' look at next cell 
      If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then 
       For i = RowNum + 1 To 10 
        If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then 
         NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value 
        ' MsgBox "New Value is " & NewValue 
         Cells(RowNum + 1, CurrCol).Value = NewValue 
         RowNum = RowNum + 1 
        End If 

       Next 


      End If 

      'now delete currCol+1 
      Range(Columns(CurrCol + 1), Columns(CurrCol + 1)).Select 
      Selection.Delete Shift:=xlToLeft 

     End If 


    'Advance the counter 
    CurrCol = CurrCol + 1 
Wend 

End Sub 

Answer 1

당신이 보이는 라인 RowNum = RowNum + 1 함께하고 발생하는 문제. 이 행은 불필요하며 첫 번째 열 뒤에 RowNum 변수가 꺼집니다. 대신 i 변수를 사용하여 현재 행을 참조하십시오.

변경이 : 여기에

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then 
    For i = RowNum + 1 To 10 
     If Trim(Cells(RowNum + 1, CurrCol + 1).Value) <> "" Then 
      NewValue = Cells(RowNum + 1, CurrCol).Value & ", " & Cells(RowNum + 1, CurrCol + 1).Value 
     ' MsgBox "New Value is " & NewValue 
      Cells(RowNum + 1, CurrCol).Value = NewValue 
      RowNum = RowNum + 1 
     End If 

    Next 

End If 

:

If InStr(Cells(1, CurrCol + 1).Value, "Doc2") > 0 Then 
    For i = 2 To 10 
     If Trim(Cells(i, CurrCol + 1).Value) <> "" Then 
      NewValue = Cells(i, CurrCol).Value & ", " & Cells(i, CurrCol + 1).Value 
     ' MsgBox "New Value is " & NewValue 
      Cells(i, CurrCol).Value = NewValue 
     End If 
    Next i 
End If 

만 10 행 2에서 루프하려면 다음과 같은 조정해야 (경우로 보이는입니다)