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