移動與模式搜索細胞和複製

我想實現在VBA以下移動與模式搜索細胞和複製

Input Workbook1 
Index Value 
1  a 
2  a 
3  b 
4  c 
5  a 
6  b 
7  a 
8  c

輸出Workbook2

我想有輸出在下面的格式，這樣我可以產生具有相同的X軸圖表

Index Value 1 Value 2  Value 3 
1  a  
2  a  
3    b 
4        c 
5  a  
6    b 
7  a  
8        c

我使用兩個功能，第一個從工作簿1移動兩列，workbook2

Sub MOVE() 
    Sheets("Workbook1").Columns("A").Copy Sheets("Sheet1").Range("A1") 
    Sheets("Workbook1").Columns("B").Copy Sheets("Sheet1").Range("B1")` 
end sub

第二個功能是：

Sub move_a() 
    Worksheets("Sheet1").Activate 
    Dim myR As Range 
    Set myR = Range("B:B").Find("PATTERN_A") 
    Do While Not myR Is Nothing 
     myR.Insert xlToRight 
     Set myR = Range("B:B").FindNext 
    Loop 
end sub

，但第二個一個不工作

來源

2015-09-28 Aditya Tomar

我是Excel中的第一個計時器。任何反饋高度讚賞:) –

歡迎來到SO - 你可以請張貼你到目前爲止已經嘗試過的任何代碼，以及它產生的輸出，以便我們可以縮小你的問題。謝謝。 –

Sub MOVE（）工作表（「Workbook1」）。列（「A」）。複製工作表（「Sheet1」）。範圍（「A1」）工作表（「Workbook1」）。列（「B」）。表（「工作表Sheet」）範圍（「B1」）結束子子move_a（）工作表（「工作表Sheet」）激活昏暗MYR作爲範圍集MYR =範圍（「B：B」）。。。找到（「PATTERN_A」）雖然不myR是沒有 myR.Insert xlToRight Set myR = Range（「B：B」）。FindNext Loop –

我已經把你的兩個操作在同一子過程。首先對整個塊執行復制，然後根據B列中的值插入單元格以將值向右移。

Sub move_it_all() 
    Dim rw As Long, a As Long 
    With Worksheets("Sheet1") 
     Worksheets("Workbook1").Cells(1, 1).CurrentRegion.Copy _ 
      Destination:=.Cells(1, 1) 
     For rw = 2 To .Cells(Rows.Count, "B").End(xlUp).Row 
      a = Asc(UCase(Right(.Cells(rw, 2).Value2, 1))) 
      If a > 65 And a <= 90 Then 
       .Cells(rw, 2).Resize(1, a - 65).Insert shift:=xlToRight 
      End If 
      .Cells(1, a - 63) = "Value" & a - 64 
     Next rw 
    End With 
End Sub

我會承認一些混亂名爲Workbook1通過工作表。您可能需要調整複製粘貼的源和目標。

來源

2015-09-28 12:26:24 Jeeped

非常感謝。它的工作和問題解決:) –

移動與模式搜索細胞和複製

回答

相關問題