VBA将多列数据组合成1列
我对VBA来说还是比较新的，并且在寻求帮助之前，一直在想尽一切办法来完成这个任务，但是无法弄清楚。
我有一个多个选项卡的Excel文件。 我只关心其中的两个。 我需要将基于“Roadmap”选项卡的值不是空白的行组合到“PPPP”选项卡上的B列中。 我所拥有的代码将为第一组数据做到这一点，然后用第二组数据replace这些数据。
Sub Move_PPPP() Sheets("PPPP").Select Rows("2:1000").Select Selection.ClearContents Dim rowCount2 As Long, shtSrc As Worksheet Dim shtDest As Worksheet Dim rng2 As Range Dim currentRow As Long Set shtSrc = Sheets("Roadmap") Set shtDest = Sheets("PPPP") rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = 2 For Each cell2 In rng2.Cells If cell2.Value <> "" Then shtDest.Range("B" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 10).Text shtDest.Range("B" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 11).Text shtDest.Range("B" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 12).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 End Sub 我试图添加一个范围为我的目标工作表，但这样做只给我9行的最后一行数据从标签“路线图”
Sub Move_PPPP() Sheets("PPPP").Select Rows("2:1000").Select Selection.ClearContents Dim rowCount2 As Long, shtSrc As Worksheet Dim columnCount As Long Dim shtDest As Worksheet Dim rng2 As Range Dim rng As Range Dim currentRow As Long Set shtSrc = Sheets("Roadmap") Set shtDest = Sheets("PPPP") rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row columnCount = shtDest.Cells(Columns.Count, "B").End(xlUp).Row Set rng2 = shtSrc.Range("C6:C" & rowCount2) Set rng = shtDest.Range("B2:B" & columnCount & currentRow) currentRow = 2 For Each cell2 In rng2.Cells If cell2.Value <> "" Then rng.Value = " " & cell2.Text & " - " & cell2.Offset(0, 10).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 End Sub
样本数据
路线图选项卡
专栏：CDEFGHIJKLM头：项目状态开放closures名称P1 P2 P3 P4 P5 P6
第1行：FISMA新build是否Albert不详不详不适用不适用新date旧数据第2行：QRD已closures否是Albert不适用不适用已closures
期望的结果。 当M <>空白时，将C列与M列合并，遍历整行并将该数据放入PPPP选项卡的B列。 然后，当N <>空白时，将列C与N结合，并将其放在PPPP选项卡B列下的列M的数据下。
PPPP标签
细胞B2 FISMA – 新的一天
单元格B4 FISMA – 旧数据QRD – 已closures
解：
Sub Move_PPPP() Sheets("PPPP").Select Rows("2:1000").Select Selection.ClearContents Dim rowCount2 As Long, shtSrc As Worksheet Dim shtDest As Worksheet Dim rng2 As Range Dim currentRow As Long Set shtSrc = Sheets("Roadmap") Set shtDest = Sheets("PPPP") rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row For Each cell2 In rng2.Cells If cell2.Value2 <> "" Then shtDest.Range("A" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 9).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1 For Each cell2 In rng2.Cells If cell2.Value2 <> "" Then shtDest.Range("A" & currentRow + 1).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 10).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1 For Each cell2 In rng2.Cells If cell2.Value2 <> "" Then shtDest.Range("A" & currentRow + 1).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 11).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1 For Each cell2 In rng2.Cells If cell2.Value2 <> "" Then shtDest.Range("A" & currentRow + 1).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 12).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2
结束小组
在第一个版本上，试试这个：
Sub Move_PPPP() Sheets("PPPP").Select Rows("2:1000").Select Selection.ClearContents Dim rowCount2 As Long, shtSrc As Worksheet Dim shtDest As Worksheet Dim rng2 As Range Dim currentRow As Long Set shtSrc = Sheets("Roadmap") Set shtDest = Sheets("PPPP") rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row Set rng2 = shtSrc.Range("C6:C" & rowCount2) currentRow = shtDest.Range("B" & Rows.Count).End(xlUp).Row For Each cell2 In rng2.Cells If cell2.Value <> "" Then shtDest.Range("B" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 10).Text shtDest.Range("B" & currentRow + 1).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 11).Text shtDest.Range("B" & currentRow + 2).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 12).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 Set rng2 = shtSrc.Range("D6:D" & rowCount2) currentRow = shtDest.Range("B" & Rows.Count).End(xlUp).Row + 1 For Each cell2 In rng2.Cells If cell2.Value <> "" Then shtDest.Range("B" & currentRow).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 10).Text shtDest.Range("B" & currentRow + 1).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 11).Text shtDest.Range("B" & currentRow + 2).Value2 = " " & cell2.Text & " - " & cell2.Offset(0, 12).Text currentRow = currentRow + 1 ElseIf cell2.Value = "" Then End If Next cell2 End Sub