用于“堆叠”列的VBA解决方案

时间:2012-03-13 19:50:24

标签: excel vba

下面是我正在使用的表格的片段。

从左到右我需要知道如何将整个第二列附加到第一列。因此,从第二列的V5789开始,需要将其下面的所有内容放在第一列中的V854之后。第三列需要“堆叠”在第二列的底部。因此2附加到1,3附加到2,4附加到3.等等。

任何线索?

enter image description here

3 个答案:

答案 0 :(得分:6)

这是另类的吗?只有2次调用工作表和一个循环。

Sub append()
Dim g, newArray
Dim strJoin As String
Dim x As Integer

g = Sheet1.Cells(1, 1).CurrentRegion.Value

For x = 1 To UBound(g, 2)
    strJoin = strJoin & Replace(Join(Application.Transpose(Application.Index(g, 0, x)), "~/"), "/~", "")
    If Right(strJoin, 2) <> "~/" And x <> UBound(g, 2) Then strJoin = strJoin & "~/"
Next x

    newArray = Split(strJoin, "~/")

    Columns(1).Cells(1).Resize(UBound(newArray) + 1).Value = Application.Transpose(newArray)

End Sub

答案 1 :(得分:3)

试试这个:

Sub DoooooooooIT()

    Dim col As Range, _
        found As Range
    Dim currRow As Integer

    currRow = ActiveSheet.Range("A:A").Find("", after:=ActiveSheet.Range("A1"), lookat:=xlWhole, searchdirection:=xlNext).Row

    For Each col In ActiveSheet.UsedRange.Columns
      If col.Column <> 1 Then
        Set found = col.EntireColumn.Find("", after:=col.Cells(1, 1), lookat:=xlWhole, searchdirection:=xlNext)
        Set found = ActiveSheet.Range(col.Cells(1, 1), found)
        found.Copy
        ActiveSheet.Cells(currRow, 1).PasteSpecial
        currRow = currRow + found.Cells.Count - 1
      End If
    Next col

End Sub

答案 2 :(得分:1)

我会通过使用2 for循环来解决这个问题:外部循环将在2处开始计数变量,然后以1的步长迭代。这将迭代您的列。

在该循环中,有一个嵌套的for循环,它遍历唯一列的每一行。它将从第一行和下一行迭代,检查每个循环,如果外循环列和内循环行所给出的位置的单元格中有任何内容(请检查cell.value =“”)。一旦找到该列中的第一个空单元格,让它将第3行中的所有内容复制到外部循环列中的行计数变量,并将其粘贴到第3行的上一列中。

我提供的是伪代码而不是实际的代码,因为我不相信这会让你自己写得太难而且我现在没有时间,所以你可以早点做到这一点。我也有机会。但是,如果您需要进一步的帮助,请告诉我,如果有机会,我可以为您处理一些代码。

编辑:忘记添加,确保包含一些内容来处理第二列数据需要进入第一列的位置的唯一位置。如果你只是包含“如果PasteToColumn = 1然后粘贴到单元格A9”或类似的东西

再次编辑:这是我的新版和改进版!让我知道你的想法/是否有效

Sub MoveStuff()

Dim rowcounter As Integer
Dim columncounter As Integer
rowcounter = 1
columncounter = 2

Do While Cells(rowcounter, columncounter).Value <> ""
    Do While Cells(rowcounter, columncounter).Value <> ""
        rowcounter = rowcounter + 1
    Loop
    Range(Cells(3, columncounter), Cells(rowcounter - 1, columncounter)).Cut (Columns(columncounter - 1).End(xlDown).Offset(rowoffset:=1))
    columncounter = columncounter + 1
    rowcounter = 1
Loop

End Sub