准备好迎接挑战了吗？我无法调试这个脚本

Question

（我正在为 Mac、v16.53 和 OS Catalina v10.15.7 开发 Excel）

我有一个名为 SCRIPT 的 Excel 工作簿，其中有 2 个 sheet。 Sheet 1 有数据输入区域，sheet 2 将这些条目编译成伪table。 sheet 1 中的数据会随着采访的每个新人而变化。 sheet 2 中的数据位于 A、B、H、I 和 J 列中，不连续并且并不总是填充第 1 行。我需要抓取这 5 列并将它们保存到一个名为 Telesales-Leads-TODAY'S DATE 的新 csv 文件中。（到目前为止，我已经能够做到这一点。）

导致我出现问题的脚本部分是当已经创建了 Telesales-Leads-TODAY'S DATE 文件时。该脚本应该：

检查 Telesales-Leads-TODAY'S DATE 是否已经存在，如果不存在则开始一个新的，copying/pasting 新的 SCRIPT 数据并保存 Telesales-Leads-TODAY'S DATE 文件。
如果 Telesales-Leads-TODAY'S DATE 文件确实存在：从 SCRIPT 工作簿复制新数据，打开 Telesales-Leads-TODAY'S DATE 文件并找到第一个 100% 空列并将 SCRIPT 数据粘贴到Telesales-Leads-TODAY'S DATE，最后以 csv 格式保存同名文件 (Telesales-Leads-TODAY'S DATE)。

我将我在网上找到的零零碎碎的东西拼凑在一起制作了这个脚本。

到目前为止，它在从 SCRIPT 工作簿复制数据之后但在它有机会完全打开 Telesales-Leads-TODAY'S DATE 文件之前抛出错误。

我知道这看起来很乱。（我当然可以使用函数和额外的子程序，但我现在只想让它工作。）

如何将其固定为运行应有的方式？（我正在使用 MsgBox 尝试自己调试它，但我并没有走得太远。）

TIA 提供的任何帮助。

Sub BackUpScriptData()
 
Dim strFileName As String
Dim strFileExists As String
Dim finalcolumn As Integer
Dim firstemptycolumn As Integer
Dim csvOpened As Workbook
Dim oneCell As Range
Dim myCSVFileName As String
Dim myWB As Workbook
Dim tempWB As Workbook
Dim rngToSave As Range
Dim col As String
Dim ColumnNumber As Integer
Dim ColumnLetter As String
Dim colstart As String
Dim CellAddress As String
Dim TestChar As String
Dim NumberToLetter As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
On Error GoTo err

    strFileName = "/Users/XXXXXXXX/Library/Group Containers/XXXXXXXX.Office/User Content.localized/Startup.localized/Excel/" & "Telesales-Leads-" & VBA.Format(VBA.Now, "mm-dd-yyyy") & ".csv"
    strFileExists = Dir(strFileName)

If strFileExists = "" Then
MsgBox strFileName & " ~~~~~~~~doesn't exist"
    Set myWB = ThisWorkbook
    myCSVFileName = "/Users/XXXXXXXX/Library/Group Containers/XXXXXXXX.Office/User Content.localized/Startup.localized/Excel/" & "Telesales-Leads-" & VBA.Format(VBA.Now, "mm-dd-yyyy") & ".csv"

    Set rngToSave = Range("A1:B69,H1:J69")
    rngToSave.Copy

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs FileName:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With


   
    Else
        Set myWB = ThisWorkbook
        Set rngToSave = Range("A1:B69,H1:J69")
        rngToSave.Copy
        
        Set csvOpened = Workbooks.Open(FileName:=strFileName)

MsgBox "csvOpened is " & csvOpened
        
        With csvOpened
            Set oneCell = Range("A1")

                Do While WorksheetFunction.CountA(oneCell.EntireColumn)
                 Set oneCell = oneCell.Offset(0, 1)
                Loop

MsgBox "oneCell.Column is " & oneCell.Column
        
        End With
         
         CellAddress = Cells(1, ColNum).Address
            For i = 2 To Len(CellAddress)
                TestChar = Mid(CellAddress, i, 1)
                    If TestChar = "$" Then Exit For
                    NumberToLetter = NumberToLetter & Mid(CellAddress, i, 1)
                    Next i

MsgBox "colstart is " & colstart
        
        With csvOpened
            .Sheets(1).Range(colstart & "1").PasteSpecial xlPasteValues
            .SaveAs FileName:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
            .Close
        End With
        
End If

err: MsgBox "failed to copy."
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

创建新工作簿或更新现有工作簿的代码基本相同，唯一的区别是要粘贴数据的列。由于这是一个 csv 文件，因此 UsedRange 是确定最后一个清除列的简单方法。

Sub BackUpScriptData2()

    Const FOLDER = "/Users/XXXXXXXX/Library/Group Containers/XXXXXXXX.Office/" & _
                  "User Content.localized/Startup.localized/Excel/"
    Const PREFIX = "Telesales-Leads-"
 
    Dim wb As Workbook, wbCSV As Workbook
    Dim ws As Worksheet, rngToSave As Range
    Dim colNum As Long, myCSVFileName As String

    myCSVFileName = PREFIX & VBA.Format(VBA.Now, "mm-dd-yyyy") & ".csv"
    
    ' check if file exists
    If Len(Dir(FOLDER & myCSVFileName)) = 0 Then
        ' not exists
        MsgBox "'" & myCSVFileName & "'" & vbCrLf & _
               "does not exist, it will be created", vbInformation, FOLDER
        Set wbCSV = Workbooks.Add()
        colNum = 1
    Else
        ' exists
        Set wbCSV = Workbooks.Open(FOLDER & myCSVFileName)
        With wbCSV.Sheets(1).UsedRange
            colNum = .Column + .Columns.Count
        End With
        MsgBox "'" & myCSVFileName & "'" & vbCrLf & _
               "exists, it will extended from column " & colNum, vbInformation, FOLDER
    End If

    ' copy and save
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet2")
    Set rngToSave = ws.Range("A1:B69,H1:J69")
    rngToSave.Copy

    With wbCSV
        .Sheets(1).Cells(1, colNum).PasteSpecial xlPasteValues
        .SaveAs Filename:=FOLDER & myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close False
    End With
    MsgBox "File saved to " & myCSVFileName, vbInformation, FOLDER

End Sub

准备好迎接挑战了吗？我无法调试这个脚本

Up for a challenge? I can't debug this script

debugging

macos

excel

vba

office365