Question

我收到了F，G，H和I列中的数据。我需要将所有数据全部放入E列并取出重复数据和空白单元格。我到目前为止的代码工作，但它将它们全部放在同一行，并没有将它们保持在适当的行。我需要他们留在他们目前所在的同一行，但只是转录到另一列。这就是我到目前为止所做的：

Sub Sample()

    Dim ws As Worksheet
    Dim LastRow As Long, lastCol As Long, i As Long
    Dim Rng As Range, aCell As Range, delRange As Range '<~~ Added This
    Dim MyCol As New Collection

    ~~> Change this to the relevant sheet name
    Set ws = Sheets("Sheet1")

    With ws
        '~~> Get all the blank cells
        Set delRange = .Cells.SpecialCells(xlCellTypeBlanks)  '<~~ Added This

        '~~> Delete the blank cells
        If Not delRange Is Nothing Then delRange.Delete  '<~~ Added This

        LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
        Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False).Row

        lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _
        Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, MatchCase:=False).Column

        Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)

        'Debug.Print Rng.Address
        For Each aCell In Rng
            If Not Len(Trim(aCell.Value)) = 0 Then
                On Error Resume Next
                MyCol.Add aCell.Value, """" & aCell.Value & """"
                On Error GoTo 0
            End If
        Next

        .Cells.ClearContents

        For i = 1 To MyCol.Count
            .Range("A" & i).Value = MyCol.Item(i)
        Next i

        '~~> OPTIONAL (In Case you want to sort the data)
        .Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With

End Sub

Answer 1

试试这个。

Sub CopyThingy()

Dim wb As Workbook
Dim ws As Worksheet
Dim lCount As Long
Dim lCountMax As Long
Dim lECol As Long
Dim lsourceCol As Long

    lECol = 5 '* E column
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1) '*Your Sheet

    lCountMax = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    lsourceCol = 6
    lCount = lCountMax

    Do While lCount > 1

        If ws.Cells(lCount, lsourceCol) <> "" Then
            ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
        End If
        lCount = lCount - 1

    Loop

    lCountMax = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    lsourceCol = 7
    lCount = lCountMax

    Do While lCount > 1

        If ws.Cells(lCount, lsourceCol) <> "" Then
            ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
        End If
        lCount = lCount - 1

    Loop

    lCountMax = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    lsourceCol = 8
    lCount = lCountMax

    Do While lCount > 1

        If ws.Cells(lCount, lsourceCol) <> "" Then
            ws.Cells(lCount, lECol).Value = ws.Cells(lCount, lsourceCol).Value
        End If
        lCount = lCount - 1

    Loop

End Sub

使用vba移动数据

1 个答案: