确定这里是一个建议。 SO精神的一部分是你应该展示并分享你现在已经尝试过的东西。 一个起点可能是用文字写下如何解决问题,尝试编码并研究差距。作为一个可能的例子,请参阅下面代码中的我的评论。如果你仍然卡住了。然后发布您的问题。
所以十分首发可能如下:
Sub concat()
Dim sdRow As Long, sdcol As Long, ldRow As Long, ldCol As Long
Dim rowNo As Long, resultRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim keyVal As String
'assume original data is in Sheets("Data")
'assume result data is in Sheets("Data2")
Set ws1 = Sheets("Data")
Set ws2 = Sheets("Data2")
'original data block r/c
sdRow = 2
sdcol = 1
ldRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
ldCol = ws1.Cells(sdRow, Columns.Count).End(xlToLeft).Column
'assume result data set in Sheets("Data2") is placed in same sheet position
'as in Sheets("Data") and copy headings
ws1.Activate
ws1.Range(Cells(sdRow, sdcol), Cells(sdRow, ldCol)).Copy _
Destination:=ws2.Cells(sdRow, sdcol)
'sort original data
ws1.Activate
ws1.Range(Cells(sdRow, sdcol), Cells(ldRow, ldCol)).Select
Selection.Sort Key1:=Columns(sdcol), Order1:=xlAscending, _
Key2:=Columns(sdcol + 1), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'loop through original data
rowNo = sdRow + 1
resultRow = rowNo
Do While rowNo < ldRow
'Test if names are the same
keyVal = Cells(rowNo, sdcol) & Cells(rowNo, sdcol + 1)
If keyVal = Cells(rowNo + 1, sdcol) & Cells(rowNo + 1, sdcol + 1) Then
'copy data row to Sheet("Data2")
ws1.Range(Cells(rowNo, sdcol), Cells(rowNo, ldCol)).Copy _
Destination:=ws2.Cells(resultRow, sdcol)
'modify 'Number' cell in Sheet("Data2") if required
If ws1.Cells(rowNo, sdcol + 2) = ws1.Cells(rowNo + 1, sdcol + 2) Then
'do nothing
Else
ws2.Cells(resultRow, sdcol + 2) = Str(ws1.Cells(rowNo, sdcol + 2)) & "," & Str(ws1.Cells(rowNo + 1, sdcol + 2))
End If
'modify 'Sign' cell in Sheet("Data2") if required
If ws1.Cells(rowNo, sdcol + 3) = ws1.Cells(rowNo + 1, sdcol + 3) Then
'do nothing
Else
ws2.Cells(resultRow, sdcol + 3) = ws1.Cells(rowNo, sdcol + 3) & "," & ws1.Cells(rowNo + 1, sdcol + 3)
End If
resultRow = resultRow + 1
Else
'copy data 'as is' to Sheet("Data2")
ws1.Range(Cells(rowNo, sdcol), Cells(rowNo, ldCol)).Copy _
Destination:=ws2.Cells(resultRow, sdcol)
resultRow = resultRow + 1
End If
rowNo = rowNo + 1
Loop
End Sub
串连两个文件中的两列,然后合并线 – 2014-09-10 13:54:28
@让FrançoisCorbett:我是新来的,我不知道要搜索什么对于。你能指点我什么可以做到的吗? – Dsine 2014-09-10 15:13:00
@KarolMarianSłuszniak:我将这两列连接起来,但是如何合并它?它似乎没有做我上面指出的? – Dsine 2014-09-10 15:13:40