8行到具有空白VBA的列

时间:2014-06-29 03:42:29

标签: excel vba excel-vba

请推荐一个代码: 我需要将8行转换为单个列。一个例子如下所示。我想保留所有空白单元格。我总是需要合并8行,即使有些单元格可能是空白的(例如下面的例子)。我最多可以有6列数据。  任何有关这方面的帮助将不胜感激。

此:

columnA  columnB   columnC
AAAA     BBBB      CCCC
AAAA     BBBB      CCCC
AAAA     BBBB      CCCC    
AAAA     blank     blank
AAAA     blank     blank
AAAA     blank     blank
blank    blank     blank
blank    blank     blank

对此:

columnA

AAAA
AAAA
AAAA
AAAA
AAAA
AAAA
blank
blank
BBBB
BBBB
BBBB
blank
blank
blank
blank
blank
CCCC
CCCC
CCCC
blank
blank
blank
blank
blank

2 个答案:

答案 0 :(得分:0)

此代码应该可以满足您的需求

Sub test()
Dim startRow As Integer
Dim startColumn As Integer
Dim LastRow As Integer
Dim LastColumn As Integer
Dim actRow As Integer
Dim actColumn As Integer
Dim targetRow As Integer

startRow = 1   
startColumn = 1
LastRow = 8
LastColumn = 6
targetRow = LastRow + 1

For actColumn = startColumn + 1 To LastColumn
    For actRow = startRow To LastRow
        With ActiveSheet
            .Cells(targetRow, 1) = .Cells(actRow, actColumn)
            .Cells(actRow, actColumn).Clear
        End With
        targetRow = targetRow + 1
    Next actRow
Next actColumn

End Sub

您可以改进代码,例如使用ActiveSheet取代Sheets("sheetname")语句

答案 1 :(得分:0)

以下代码非常通用,可根据您的用户界面的需要进行修改。

逻辑如下:

  1. 将范围复制到内存
  2. 根据需要将内容重新排列为一维字符串数组
  3. 加入由换行符(CRLF for Windows)
  4. 分隔的数组元素
  5. 将此连接的字符串复制到系统剪贴板
  6. 因此,您可以突出显示要重新排列的范围,并通过电子表格上的某个按钮或功能区中的按钮运行宏,并将所需的输出放入剪贴板。

    然后您只需将其粘贴到需要使用它的任何地方。

        Sub CopyToClipboard()
            Dim Clipboard As New MSForms.DataObject
            ' Create Clipboard data object
    
            Dim CopiedArray As Variant
            CopiedArray = Selection
            ' Randomly sized range copied
    
            Dim nRows As Long, nCols As Long
            nRows = UBound(CopiedArray, 1)
            nCols = UBound(CopiedArray, 2)
    
            Dim OutputStr() As String
            ReDim OutputStr(1 To nRows * nCols)
            ' Create a uni dimensional string array for output
    
            Dim i As Long, j As Long
            For j = 1 To nCols
                For i = 1 To nRows
                    OutputStr((j - 1) * nRows + i) = CopiedArray(i, j)
                Next i
            Next j
    
            Clipboard.SetText Join(OutputStr, vbCrLf)
            ' The string array is joined with the
            ' Carriage Return + LineFeed (CRSF) delimiter
    
    
            Clipboard.PutInClipboard
            ' Contents of the Clipboard object are
            ' copied to the system clipboard
    
            Set Clipboard = Nothing
            ' Destroy clipboard object
        End Sub