Question

我想提供一些启动VBA代码的提示：

我有2张。纸张（2）的每一行在每个单元格中都有文本，但在它们之间它可以有一些空单元格。我的目标是从sheet（2）的row1开始从A1复制到E1，然后在工作表（1）第1行中复制它，但它们之间没有空单元格。

我编辑我的帖子是因为我没有考虑过这个重要的细节。我想删除同一行中的任何副本，但要保留第一个条目。

重复操作直到最后一行。

数据例证：

工作表（2）： row1 cell1，cell2，cell3，cell4，cell5：

**ABC**,   ,DEF,**ABC**,GHI

row（2）cell1，cell2，cell3，cell4，cell5：

ZZZ,  ,   ,   ,YEU

预期结果：工作表（1）： row1 cell1，cell2，cell3，cell4，cell5：

**ABC**,DEF,GHI,  ,    ,

row（2）cell1，cell2，cell3，cell4，cell5：

ZZZ,YEU,   ,   ,

提前感谢您的帮助！

Answer 1

我找到了它：

Sub M()
    lastrow = Sheets("Sheet2").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    For i = 1 To lastrow
        Sheets("Sheet2").Range("A" & i & ": M" & i).Copy Sheets("Sheet1").Range("A" & i) ' Change Column M as required
        Sheets("Sheet1").Range("A" & i & ": M" & i).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
    Next
End Sub

Answer 2

试试这个：

Sub stack_overflow()
Dim lngLastRow As Long
Dim xNum As Long
Dim xCell As Range
Dim shtFrom As Worksheet
Dim shtTo As Worksheet
Dim lngColCount As Long

'Change the two lines below this to change which sheets you're working with
Set shtFrom = ActiveWorkbook.Sheets(2)
Set shtTo = ActiveWorkbook.Sheets(1)

lngLastRow = shtFrom.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

For xNum = 1 To lngLastRow
    lngColCount = 1
    For Each xCell In shtFrom.Range("A" & xNum & ":E" & xNum)
        If xCell.Value <> "" Then
            If shtTo.Range("A" & xNum & ":E" & xNum).Find(What:=xCell.Value, LookIn:=xlValues, Lookat:=xlWhole) Is Nothing Then
                shtTo.Cells(xNum, lngColCount).Value = xCell.Value
                lngColCount = lngColCount + 1
            End If
        End If
    Next xCell
Next xNum

End Sub

Answer 3

在收集每行的值后，您必须提供一些字符串操作才能删除空白。

Sub contract_and_copy()
    Dim rw As Long, lr As Long, lc As Long, ws As Worksheet
    Dim sVALs As String, vVALs As Variant
    Set ws = Sheets("Sheet1")
    With Sheets("Sheet2")
        lr = .Cells.Find(what:=Chr(42), after:=.Cells(1, 1), SearchDirection:=xlPrevious).Row
        For rw = 1 To lr
            If CBool(Application.CountA(Rows(rw))) Then
                vVALs = .Cells(rw, 1).Resize(1, .Cells(rw, Columns.Count).End(xlToLeft).Column).Value
                sVALs = ChrW(8203) & Join(Application.Index(vVALs, 1, 0), ChrW(8203)) & ChrW(8203)
                Do While CBool(InStr(1, sVALs, ChrW(8203) & ChrW(8203)))
                    sVALs = Replace(sVALs, ChrW(8203) & ChrW(8203), ChrW(8203))
                Loop
                sVALs = Mid(sVALs, 2, Len(sVALs) - 2)
                vVALs = Split(sVALs, ChrW(8203))
                ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, UBound(vVALs) + 1) = vVALs
            End If
        Next rw
        'Debug.Print lr
    End With
End Sub

我使用零长度空间作为分隔符，因为它通常不太可能是用户数据的一部分。

Answer 4

您也可以尝试以下方法......

select

从一个范围复制并在另一个工作表中过去连续的下一个空单元格

4 个答案: