VBA:"对于每个"循环选择:根据选择中的位置复制某些单元格

时间:2014-05-17 20:22:40

标签: excel loops excel-vba select vba

我会尽量解释它。

我有一组文件。在每个文件中都有一个至少包含两列的工作表。第一列包含描述,第二列(和以下)列包含值(或者在我的示例中为字符串)。大多数文件只有两列。但是,有些列有两列以上。

我编写了第一个循环,用于检查列表文件中的第三列是否为空。如果为空,则文件只有两列并被跳过。另外(如果有两列以上),运行子程序将工作表拆分为只有两列的单个文件。

重要的是要知道每列包含有关项目的信息,第一行包含项目名称。

我的想法是在第二列之后的第一行中选择单元格(例如C1到E1;列数可能不同)并在该选择上运行另一个for each循环。

我创建了一个空的项目描述文件。根据循环的位置(如果它位于C1或D1或E1),我需要宏来复制相应单元格下方的单元格(例如,如果循环位于C1,它应该复制C2:C10)并将其粘贴到固定位置在空项目描述文件中。

当前进展

Sub sorter()

Dim mrunner As Workbook
Dim currentwb As Workbook
Dim FileNames As Variant

ThisWorkbook.Activate
Set mrunner = ActiveWorkbook

Range("A:A").Select

For Each FileNames In Selection

    Workbooks.Open Filename:=ThisWorkbook.Path & "\old\" & FileNames & ".xlsx"

    Set currentwb = ActiveWorkbook

    If Range("C2") = 0 Then

    currentwb.SaveAs Filename:=ThisWorkbook.Path & "\new\" & FileNames & ".xlsx"
    currentwb.Close

    Else

    Call splitter(currentwb,mrunner)

    End If

Next FileNames

End Sub


Sub splitter(currentwb,mrunner)

Dim basewb As Workbook
Dim newwb As Workbook
Dim subname As Variant
Dim master As Range
Dim segment As Range
Dim triggers As Range

Range("C2").Select
Range(ActiveCell, Cells(ActiveCell.Row, Columns.Count)).Select

For Each subname In Selection

    Set master = Range("B1")
    Set segment = Range(currentwb.Cells(subname.Column, 2), currentwb.Cells(subname.Column, 3))
    Set triggers = Range(currentwb.Cells(subname.Column, 4), currentwb.Cells(subname.Column, 43))

    ' save in new worksheet

    Workbooks.Open Filename:=mrunner.Path & "\RisikoTriggerReport_base.xlsx"

    Set newwb = ActiveWorkbook

    Range("B1") = master
    Range("B2") = segment
    Range("B5") = triggers

    newwb.SaveAs Filename:=mrunner.Path & "\new\" & subname & ".xlsx"
    newwb.Close

 Next subname
 currentwb.close

 End Sub

如果代码是这样的话,宏运行没有任何错误。然而

    Set master = Range("B1")
    Set segment = Range(Cells(subname.Column, 2), Cells(subname.Column, 3))
    Set triggers = Range(Cells(subname.Column, 4), Cells(subname.Column, 43))

无法正常工作。第一行有效,但其他两行不起作用。变量segment和triggers保持为空。

我曾尝试参考工作表。所以我的代码看起来像这样

    Set master = currentwb.Range("B1")
    Set segment = currentwb.Range(currentwb.Cells(subname.Column, 2), currentwb.Cells(subname.Column, 3))
    Set triggers = currentwb.Range(currentwb.Cells(subname.Column, 4), currentwb.cCells(subname.Column, 43))

但是这返回了一个错误。我的想法有什么错误? (尝试将范围链接到特定的工作簿?

1 个答案:

答案 0 :(得分:0)

您的变量子名实际上是一个范围。

for each子名称成为第一个单元格,然后是第二个,...

只需根据子名称列设置part2。符号将有所不同,因为column返回一个数字:

Dim subname As Range
...
For Each subname In Selection

    Set part1 = currentwb.Range("B1:B3") ' Exists only once in each file 
                                     ' so I can fix the range
    Set part2 = currentwb.Range(currentwb.Cells(subname.Column, 1), currentwb.Cells(subname.Column, 10))
...
Next subname

顺便说一句,currentwb实际上是一个WorkSheet吗?您需要在工作表上致电Range,不要吗?