【发布时间】：2015-04-08 15:09:53
【问题描述】：
我还是 VBA 的新手，在寻求帮助之前我一直在尝试我能想到的一切来完成这项工作，但无法弄清楚。
我有一个带有多个选项卡的 excel 文件。我只关心其中的两个。我需要将基于它们的值从选项卡“路线图”中不为空白的行组合到选项卡“PPPP”上的 B 列中。我的代码将对第一组数据执行此操作，然后用第二组数据替换该数据。
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
样本数据
路线图选项卡
列：C D E F G H I J K L M 标题：项目状态打开关闭名称P1 P2 P3 P4 P5 P6
第 1 行：FISMA 新 是 否 Albert na na na na New Day Old Data 第 2 行：QRD 已关闭 否 是 Albert na na na na na 已关闭
期望的结果。当 M 空白时将 C 列与 M 列合并，循环遍历整行并将该数据放入 PPPP 选项卡的 B 列。然后在 N 空白时将 C 列与 N 合并，并将其放在 PPPP 选项卡上，B 列位于 M 列的数据下方。
PPP 选项卡
单元格 B2 FISMA - 新的一天
单元格 B4 FISMA - 旧数据 QRD - 关闭
解决方案：
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
结束子
【问题讨论】：