Question

我需要一种动态的方法来连接一些带有分隔符的行中的一些单元格（在这个例子中为|），因为列移动（每个项目）这必须是标题名称（可能来自2到多个）需要为项目进行连接的列

我正在尝试使用数组，因为可能有多达4000,000行

我已经尝试了几个小时，这是我的努力，我知道它是very wrong，但我不知所措

谢谢

Sub CAT()

fCAT "ElementsFile", "ElementsFile", "D", Array("Age", "Gender Identity", "Ethnicity1", "Ethnicity1")

End Sub

Sub fCAT(sShtName As String, pbShtName As String, InsertCol As String, ar As Variant)
Dim myresult
Dim col1 As String, col2 As String, col3 As String, col4 As String
Dim aLR As Long, i As Long, j As Long, k As Long

'Totaly at a loss here
For i = LBound(ar) To UBound(ar)
   Dim ari As Variant
   Dim coli As String
Next i

 Set wsS = ThisWorkbook.Sheets(sShtName)
Set wsPB = ThisWorkbook.Sheets(pbShtName)

With wsS
     aLR = .Range("A" & .Rows.Count).End(xlUp).Row
   For i = LBound(ar) To UBound(ar)
       j = .Rows(1).Find(ar(i)).Column
      ari = .Range(Cells(1, j), Cells(aLR, j)).Select
 Next i
End With

 'Totaly at a loss here
 ReDim myresult(1 To aLR, 1 To aLR)
   For k = 1 To aLR
     For i = LBound(ar) To UBound(ar)
      j = wsS.Rows(1).Find(ar(i)).Column
         myresult(k, 1) = Cells(k, j) & "|" & Cells(k, j + 1) & "|" & Cells(k, j + 2) & "|" & Cells(k, j + 3)
  Next i
Next k

wsT.Range("D1").Resize(aLR, 1) = myresult

End Sub

Answer 1

这是我最终想出的一些混乱但可行的

Sub concat()
Dim myresult, CN
Dim HN As Variant
Dim wsS As Worksheet, wsPB As Worksheet
Dim str As String
Dim LR As Long, i As Long, j As Long, k As Long

HN = Array("Age", "Gender Identity", "Ethnicity1", "Ethnicity2")

 Set wsS = ThisWorkbook.Sheets("ElementsFile")
Set wsPB = ThisWorkbook.Sheets("ElementsFile")

wsPB.Columns(4).Insert

ReDim CN(0 To UBound(HN))
With wsS
      LR = .Range("A" & .Rows.Count).End(xlUp).Row
'Get Array of column numbers coresponding to Header names
    For i = 0 To UBound(HN)
         j = wsS.Rows(1).Find(HN(i)).Column
         CN(i) = j
    Next i
End With
ReDim myresult(1 To LR, 1 To 1)

For i = 1 To LR
str = vbNullString
   If Not (IsEmpty(Cells(i, CN(0))) And IsEmpty(Cells(i, CN(1)))) Then
      For k = UBound(HN) To 0 Step -1
         If k <> UBound(HN) Then
            str = Cells(i, CN(k)) & "|" & str
         Else: str = Cells(i, CN(k)) & str
         End If
      Next k
        myresult(i, 1) = str

      Else
      myresult(i, 1) = vbNullString
   End If
Next i
str = vbNullString
wsPB.Range("D1").Resize(LR, 1) = myresult

End Sub

按标题名称动态连接，如何执行此操作丢失

1 个答案: