在列A下複製列B和C並重復每3列

我需要能夠將每3列轉換爲1列，同時還要根據標頭名稱選擇三列並從左到右進行排序。在列A下複製列B和C並重復每3列

原始

CBAFEDIGH

輸出

ADG

BEH

CFI

我有下面的代碼，讓我能夠轉化成一列，但它並不限於此三列，每三個重複一次。我仍然試圖找出我=和步驟3

我知道排序可以通過處理3列時通過腳本設置。只需要一點點幫助。

顯式的選項

Sub COLMERGE() 
    Dim lr As Long 
    Dim lrX As Long 
    lrX = Range("A" & Rows.Count).End(xlUp).Row 
    Dim i As Long 
    Dim lc As Long 
    lc = Cells(1, Columns.Count).End(xlToLeft).Column 

    Application.ScreenUpdating = False 
    For i = 2 To lc 
    lr = Range("A" & Rows.Count).End(xlUp).Row 
    Range(Cells(2, i), Cells(lrX, i)).Cut Range("A" & lr + 1) 
    Next i 
    Range(Cells(1, 2), Cells(1, lc)).ClearContents 
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 

End Sub

來源

2017-06-21 John D

我很困惑你的榜樣。你列出你的列數據爲'C B A F E D I G H'，然後聲明你希望第一個輸出是'ADG'，這是第三，第六和第七列，而不是我所期望的描述中的3,6和9。然後你聲明第二個輸出應該是'BEH'，這是第二，第五和第九列，而不是你描述中預期的2，5，8。而'CFI'是第一，第四和第七，所以它是唯一符合你描述的*。你能澄清一下嗎？ – tigeravatar

列輸出將是ADG，列A現在具有列B和C，然後列B將具有E和H，因此列第四。我希望有所幫助。 –

但爲什麼它是ADG而不是ADH？根據你的描述，它*應該*是ADH，而不是ADG – tigeravatar

我能得到的列與下面的代碼正確處理

Option Explicit 

Sub ColMerge() 
    Dim lr As Long 
    Dim lrX As Long 
    lrX = Range("A" & Rows.Count).End(xlUp).Row 
    Dim i As Long 
    Dim j As Long 
    Dim lc As Long 
    Dim ws As Worksheet 
    lc = Cells(1, Columns.Count).End(xlToLeft).Column 

    Application.ScreenUpdating = False 
    For i = 2 To lc Step 3 

    Range(Cells(2, i), Cells(31, i)).Cut Range(Cells(32, i - 1), Cells(61, i - 1)) 
    Range(Cells(2, i + 1), Cells(31, i + 1)).Cut Range(Cells(62, i - 1), Cells(91, i - 1)) 

    Next i 

    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
    MsgBox ("Completed") 

End Sub

我能得到那種通過使用下面的代碼：

Option Explicit 

Sub ReSort_LtoR() 
    Dim lr As Long 
    Dim lrX As Long 
    lrX = Range("A" & Rows.Count).End(xlUp).Row 
    Dim i As Long 
    Dim j As Long 
    Dim lc As Long 
    Dim ws As Worksheet 
    lc = Cells(1, Columns.Count).End(xlToLeft).Column 

    Application.ScreenUpdating = False 
    For i = 1 To lc Step 3 

    Range(Cells(1, i), Cells(31, i + 2)).Select 
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range(Cells(1, i), Cells(1, i + 2)), _ 
     SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
    With ActiveWorkbook.Worksheets("Sheet2").Sort 
     .SetRange Range(Cells(1, i), Cells(31, i + 2)) 
     .Header = xlGuess 
     .MatchCase = False 
     .Orientation = xlLeftToRight 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Next i 

    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
    MsgBox ("Completed") 

End Sub

來源

2017-06-21 18:05:46

在列A下複製列B和C並重復每3列

回答

相關問題