移动与模式搜索细胞和复制

我想实现在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

非常感谢。它的工作和问题解决:) –

移动与模式搜索细胞和复制

回答

相关问题