Question

我有多个列，它们之间有一个特定的距离，我想将所有数据复制到一列。

我有一个变量n=29。

列之间的距离总是9。总列数为n*(9+1)=290，与列"KD"

相对应

带有波纹管数据的工作表名为"Importat"

 |  B  |....|  L  |....|  V  |...| AF |..until.. |  KD  |
---------------------------------------------------------
1|
2|  10 |....| 79  |....| 21  |...| 41 |..........|  22  |
3|  13 |....| 55  |....| 51  |...|    |..........|  56  |
4|  16 |....|     |....|     |...|    |..........|  67  |

结果必须如表"COD+DATA"

中的结果一样

  |  K  |
 ---------
 1|     |
 2| 10  |
 3| 13  |
 4| 16  |
 5| 79  |
 6| 55  |
 7| 21  |
 8| 51  |
 9| 41  |
.......  
 x| 22  |
 y| 56  |
 z| 67  |

任何建议我该怎么做？

Answer 1

您的示例数据并未遵循一致的模式。

Dim y As Long

For y = 2 To 300 Step 10
    Debug.Print Split(Columns(y).Address(False, False), ":")(0); ",";
Next

Answer 2

也许我误解了您的问题，但根据我的理解，您在工作簿中的Importat表中有数据。数据以列为单位，列始终以9列分隔（一直到列KD）。以下是您可以使用的一种方法：

Sub GetDataFromImportatSheet()

    Dim oIWS As Worksheet: Set oIWS = ThisWorkbook.Worksheets("Importat")
    Dim oCWS As Worksheet: Set oCWS = ThisWorkbook.Worksheets("COD+DATA")
    Dim intLastColumn As Integer: intLastColumn = oIWS.Cells(2, oIWS.Columns.Count).End(xlToLeft).Column
    Dim intLastRow As Integer
    Dim intColCounter As Integer
    Dim intCurRow As Integer
    Dim intCWSRow As Integer

    intCWSRow = 0

    For intColCounter = 2 To intLastColumn Step 9

        intLastRow = oIWS.Cells(oIWS.Rows.Count, intColCounter).End(xlUp).Row

        For intCurRow = 1 To intLastRow

            If Len(Trim(oIWS.Cells(intCurRow, intColCounter))) <> 0 Then

                intCWSRow = intCWSRow + 1
                oCWS.Cells(intCWSRow, "J").Value = intCWSRow
                oCWS.Cells(intCWSRow, "K").Value = oIWS.Cells(intCurRow, intColCounter)

            End If

        Next

    Next

End Sub

Answer 3

您要做的是重塑数据。我创建了一个复杂的宏来实现这两种方式，list - ＆gt;桌子和桌子 - ＆gt;名单。看看：http://amitkohli.com/change-lists-into-tables-and-tables-into-lists/

您可能必须创建一个中间表，其中所有数据彼此相邻，而不是相隔9列。

VBA：将工作表中的多个列复制到另一个工作表中的一列中

3 个答案: