2010 Microsoft Office Excel 多列合并

先Alt+F11 打开Microsoft Visual Basic For Applications

然后选择要合并列的Sheet

双击后在左边白色空白区域输入下面VB代码（按需求修改）

Sub 多列合并()

Dim i As Long

For i = 2 To 34110 Step 1

If Cells(i, 2) = "" Then

If Cells(i, 5) = "" Then

Cells(i, 2) = Cells(i, 3)

Else

Cells(i, 2) = Cells(i, 5)

End If

End If

Next i

End Sub

Sub 多列合并S()

Dim i As Long

Dim l As Long

Dim row_len As Long

Dim row_start As Long

Dim member_len As Long

Dim step_int As Long

Dim j As Long

Dim nameX As String

Sheet22.Activate

nameX = ActiveSheet.Name & "Jolog.net"

l = 1

step_int = 4

row_start = 4

row_len = ActiveSheet.UsedRange.rows.Count

member_len = 7

i = i + 1

Sheets.Add before:=Sheets(1)

ActiveSheet.Name = nameX

Sheets(1).Cells(l, 1).Value = "证号"

Sheets(1).Cells(l, 1).Font.Name = "黑体"

Sheets(1).Cells(l, 2).Value = "姓名"

Sheets(1).Cells(l, 2).Font.Name = "黑体"

Sheets(1).Cells(l, 3).Value = "性别"

Sheets(1).Cells(l, 3).Font.Name = "黑体"

Sheets(1).Cells(l, 4).Value = "身份证号"

Sheets(1).Cells(l, 4).Font.Name = "黑体"

Sheets(1).Cells(l, 5).Value = "筹资金额"

Sheets(1).Cells(l, 5).Font.Name = "黑体"

Sheets(1).Cells(l, 6).Value = "村委会盖 章"

Sheets(1).Cells(l, 6).Font.Name = "黑体"

Sheets(1).Cells(l, 7).Value = "是否全家参合"

Sheets(1).Cells(l, 7).Font.Name = "黑体"

Sheets(1).Cells(l, 8).Value = "是否连续参合"

Sheets(1).Cells(l, 8).Font.Name = "黑体"

Sheets(1).Cells(l, 9).Value = "是否主动缴费"

Sheets(1).Cells(l, 9).Font.Name = "黑体"

l = l + 1

For i = row_start To row_len Step step_int

For j = 1 To member_len Step 1

If Trim(Cells(i, j + 2).Value) <> "" Then

Sheets(1).Cells(l, 1).Value = "_" & Cells(i, 1).Value

Sheets(1).Cells(l, 2).Value = Cells(i, j + 2).Value

Sheets(1).Cells(l, 3).Value = Cells(i + 1, j + 2).Value

Sheets(1).Cells(l, 4).Value = "_" & Cells(i + 2, j + 2).Value

Sheets(1).Cells(l, 5).Value = Cells(i, 10).Value

Sheets(1).Cells(l, 6).Value = Cells(i, 11).Value

Sheets(1).Cells(l, 7).Value = Cells(i, 12).Value

Sheets(1).Cells(l, 8).Value = Cells(i, 13).Value

Sheets(1).Cells(l, 9).Value = Cells(i, 14).Value

l = l + 1

End If

Next j

Next i

ThisWorkbook.Save

End Sub