使用VBA

我在列F，G，H接收到的數據，和一，移動數據我需要得到所有進入E列，並採取了重複和空白單元格。我到目前爲止的代碼有效，但它將它們全部放在同一行，並且不會將它們保留在適當的行上。我需要他們留在他們目前所在的同一條線上，但只是轉錄到另一列。這是我到目前爲止：使用VBA

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

來源

2017-05-25 cboykin

看看這個答案https://stackoverflow.com/questions/28958879/macro-to-merge-and-concatenate-cells-in-excel-for-rows-in-which- information-on-o得到如何循環通過行（而不是你的單元循環）的一般想法。這會導致單元格正確合併到同一行中的一個單元格中。 –

不確定你的問題。您的代碼將所有內容放入單個列中，並分別放入單獨的行中。什麼，確切地說。你的意思是「同一行」？ –

他們開始的同一行。希望這些照片會有所幫助。第一個是之前，第二個是之後。 http://tinypic.com/r/dqtc5/9 http://tinypic.com/r/zmfvy0/9。 – cboykin

試試這個。

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

來源

2017-05-25 20:03:10

這很好用！謝謝！ – cboykin

隨時:)愉快的幫助。 –

回答

相關問題