Question

仅在不存在的情况下，我想从“ listastrategyzna”工作表中创建新文件（在同一文件夹中）。下一个偏移一个位置，并创建下一个文件，等等。我做错了什么？

Sub TworzenieZamowien()
    Dim thisWb As Workbook
    Dim nazwaPliku As String
    Set thisWb = ActiveWorkbook
    Dim aktywnaKomorka As Range
    Set aktywnaKomorka = Sheets("lista strategiczna").Range("D2")
    Dim FilePath As String
    FilePath = Dir(ActiveWorkbook.Path, vbDirectory)
      Do Until aktywnaKomorka = ""
      nazwaPliku = thisWb.Path & "\Zamówienie " & aktywnaKomorka & ".xls"
        If FilePath <> nazwaPliku Then
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:=nazwaPliku
        ActiveWorkbook.Close savechanges:=False
        aktywnaKomorka.Offset(1, 0).Select
        Else
        aktywnaKomorka.Offset(1, 0).Select
        End If
      Loop  
End Sub

Answer 1

我会在开始时设置范围，使用For循环并取消选择内容（这是个好主意）。您当前的代码不会更改aktywnaKomorka（仍为D2），您只需激活下面的下一个单元格，但是循环不会引用活动的单元格。

Sub TworzenieZamowien()

Dim thisWb As Workbook
Dim nazwaPliku As String
Set thisWb = ActiveWorkbook
Dim aktywnaKomorka As Range

With Sheets("lista strategiczna")
    Set aktywnaKomorka = .Range("D2", .Range("D" & Rows.Count).End(xlUp))
End With

Dim FilePath As String, r As Range

FilePath = Dir(ActiveWorkbook.Path, vbDirectory)

For Each r In aktywnaKomorka
    If r <> vbNullString Then
        nazwaPliku = thisWb.Path & "\Zamówienie " & r & ".xls"
        If FilePath <> nazwaPliku Then
            Workbooks.Add
            ActiveWorkbook.SaveAs Filename:=nazwaPliku
            ActiveWorkbook.Close savechanges:=False
        End If
    End If
Loop

End Sub

如果您要坚持执行Do循环而不是选择“添加此行”

set aktywnaKomorka=aktywnaKomorka.Offset(1, 0)

如何从范围创建新文件

1 个答案: