vba에서 여러 레코드의 텍스트를 조건부로 연결

Question

UniqueID Description   ConsolidatedText 
Str1  Here is a sentence  Here is a sentence 
Str2  And another sentence. And another sentence. And some words      
Str2  And some words   
Str3  123     123 
Str4  abc     abC### 
Str4  ###      

확인 - 다시 시도해 보겠습니다. 동일한 제목 및 서식이 지정되지 않은 코드로 이전 게시물을 무시하십시오 !!

고유 한 값 (텍스트)과 데이터 입력 설명 인 텍스트 필드 (잠재적으로 상당히 긴)가 각각있는 레코드 (~ 4000)가 있습니다. UniqueID 값이 여러 번 나오는 단일 레코드에 모든 설명을 연결하여 스프레드 시트를 통합해야합니다. 일반적으로 잠재적 인 값의 범위를 반복하여 "UniqueID가 같은 경우"라고 말한 다음 모든 설명 값을 가져 와서 단일 행 (첫 번째 행 또는 새 행)에서 함께 연결 한 다음 모든 이전 값을 삭제합니다 행. " 기본적으로이 샘플 데이터에서 ConsolidatedText 필드를 만든 다음 추가 행을 삭제하려고합니다. 이것은 내 VBA 프로그래밍 능력을 넘어선 것이며,이 매크로의 구조에 대한 도움은 크게 감사 할 것입니다. (이 단 하나 개의 슈팅을 경우) VBA를 사용하지 않으려면

Answer 1

아래 코드를 사용해보십시오, 당신이 헤더를 가정하고 그 고유 한 ID 열 B에서 열 A 및 설명에

Option Explicit 
Sub HTH() 
    Dim vData As Variant 
    Dim lLoop As Long 
    Dim strID As String, strDesc As String 

    '// Original data sheet, change codename to suit 
    vData = Sheet1.UsedRange.Value 

    With CreateObject("Scripting.Dictionary") 
     .CompareMode = 1 

     For lLoop = 1 To UBound(vData, 1) 
      strID = vData(lLoop, 1):strDesc = vData(lLoop, 2) 

      If Not .exists(strID) Then 
       .Add strID, strDesc 
      Else 
       .Item(strID) = .Item(strID) & " " & strDesc 
      End If 
     Next 

     '// Data output, change sheet codename to suit 
     Sheet2.Range("a1").Resize(.Count).Value = Application.Transpose(.keys) 
     Sheet2.Range("b1").Resize(.Count).Value = Application.Transpose(.items) 
    End With 

End Sub 

편집

당신이 지우고 덮어 쓰기를 원하는 경우 원본 데이터를 입력 한 다음 시도해보십시오.

Option Explicit 
Sub HTH() 
    Dim vData As Variant 
    Dim lLoop As Long 
    Dim strID As String, strDesc As String 

    '// Change all references of activesheet to your worksheet codename. 

    With ActiveSheet.UsedRange 
     vData = .Value 
     .Clear 
    End With 

    With CreateObject("Scripting.Dictionary") 
     .CompareMode = 1 

     For lLoop = 1 To UBound(vData, 1) 
      strID = vData(lLoop, 1):strDesc = vData(lLoop, 2) 

      If Not .exists(strID) Then 
       .Add strID, strDesc 
      Else 
       .Item(strID) = .Item(strID) & " " & strDesc 
      End If 
     Next 

     '// Data output, change sheet codename to suit 
     ActiveSheet.Range("a1").Resize(.Count).Value = Application.Transpose(.keys) 
     ActiveSheet.Range("b1").Resize(.Count).Value = Application.Transpose(.items) 
    End With 

End Sub 

Answer 2

, 여기에 당신이 할 수있는 것입니다 :

1. 이가 UniqueID 정렬하여 값 열 "ConsolidatedText"
2. 추가
3. (C2 드래그에서 첫 번째 드롭 끝까지 공식을) "ConsolidatedText"에서 수식을 만듭니다 =IF(A2=A3;B2&" "&B3;IF(A2=A1;"dupplicate";B2))
4. 필터를 ConsolidatedText의 "dupplicate"값이 모든 행을 삭제

동일한 ID가 2 개 이상인 경우 수식을 조정할 수 있습니다.