Windows版Excel编写的VBA宏在Mac版Excel中无法运行的解决求助

Hey there! I’ve run into similar VBA compatibility headaches between Windows and Mac Excel before, so let’s break down how to adjust your two macros to work smoothly on macOS.

1. Fixing SQLResults2XL #

The biggest roadblocks here are clipboard access (Windows vs Mac methods differ) and a few minor behavior quirks that Mac Excel is stricter about. Here’s the modified code with explanations:

Modified SQLResults2XL Code #

Public Sub SQLResults2XL()
    Dim i As Long
    Dim j As Long
    Dim ri As Long 'row in index
    Dim ro As Long 'row out index
    Dim colCount As Long
    Dim rowCount As Long
    Dim posStart As Long
    Dim posLen As Long
    Dim sheetCount As Long
    Dim str As String
    Dim lines() As String
    Dim line As String
    Dim row() As String
    Dim colWidth() As Integer
    Dim rows() As Variant ' Switched to Variant for better Mac array handling
    Dim ws As Worksheet
    Dim hRE As RegExp
    Dim hMatches As MatchCollection
    Dim tRE As RegExp
    Dim tMatches As MatchCollection
    
    ' Get clipboard text (Mac-compatible method)
    str = GetClipboardText()
    If str = "" Then
        MsgBox "Clipboard is empty!", vbExclamation
        Exit Sub
    End If
    
    str = Replace(str, Chr(13), "")
    lines = Split(str, Chr(10))
    rowCount = UBound(lines)
    
    ' Initialize regex objects
    Set hRE = New RegExp
    With hRE
        .MultiLine = False
        .Global = False
        .IgnoreCase = True
        .Pattern = "[^- ]"
    End With
    Set tRE = New RegExp
    With tRE
        .MultiLine = False
        .Global = False
        .IgnoreCase = True
        .Pattern = "^[(][0-9]*[ ][r][o][w][(][s][)][ ][a][f][f][e][c][t][e][d][)]"
    End With
    
    ' Disable screen updates for speed
    Application.ScreenUpdating = False
    sheetCount = 0
    
    For ri = 0 To rowCount
        line = Trim(lines(ri))
        Set hMatches = hRE.Execute(line)
        Set tMatches = tRE.Execute(line)
        
        If Len(Trim(line)) = 0 Then
            ' Skip empty lines
        ElseIf hMatches.Count = 0 Then
            GoSub newWorksheet
        ElseIf tMatches.Count > 0 Then
            GoSub endOfWorksheet
        Else
            GoSub processDetailLine
        End If
    Next ri
    
    Application.ScreenUpdating = True
    Exit Sub

processDetailLine:
    If colCount = 0 Then Return
    
    posStart = 1
    For i = 0 To colCount
        posLen = colWidth(i)
        ' Prevent out-of-bounds errors if line is shorter than expected
        If posStart + posLen - 1 > Len(line) Then
            rows(ro, i) = Trim(Mid(line, posStart))
        Else
            rows(ro, i) = Trim(Mid(line, posStart, posLen))
        End If
        posStart = posStart + posLen + 1 ' Skip the space separator
    Next i
    ro = ro + 1
    Return

newWorksheet:
    sheetCount = sheetCount + 1
    If sheetCount > 1 Then
        ' Explicitly add sheet at the end (Mac-friendly)
        Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    Else
        Set ws = ActiveSheet
        ws.Cells.Clear ' Clear existing content on the first sheet
    End If
    
    row = Split(line, " ")
    colCount = UBound(row)
    
    ' Resize arrays with safe bounds
    ReDim colWidth(colCount)
    ReDim rows(0 To rowCount, colCount)
    
    For i = 0 To colCount
        colWidth(i) = Len(Trim(row(i)))
    Next i
    
    ro = 0
    If ri > LBound(lines) Then
        line = Trim(lines(ri - 1))
        GoSub processDetailLine
    End If
    Return

endOfWorksheet:
    Dim rng As Range
    ' Use A1 as the starting point instead of relying on ActiveCell
    Set rng = ws.Range("A1").Resize(ro, colCount + 1)
    rng.Clear
    rng.Value = rows
    
    ' Auto-fit columns and format header
    rng.Columns.AutoFit
    Set rng = ws.Range("A1").Resize(1, colCount + 1)
    rng.Interior.ColorIndex = 15
    rng.Font.Bold = True
    Return
End Sub

' Helper function to access clipboard on Mac
Function GetClipboardText() As String
    Dim scriptStr As String
    scriptStr = "set theClipboard to the clipboard as text" & vbNewLine & "return theClipboard"
    GetClipboardText = MacScript(scriptStr)
End Function

Key Fixes: #

• Replaced Windows-only Clipboard2Text() with GetClipboardText() using AppleScript to access the clipboard.
• Switched rows() to a Variant array to avoid Mac Excel’s strict array type rules.
• Replaced ActiveCell with ws.Range("A1") to prevent unexpected selection-related bugs.
• Added bounds checking in processDetailLine to avoid errors with short lines.
• Explicitly defined where new sheets are added to match Mac Excel’s behavior.

2. Fixing RenameWorksheets #

Mac Excel is pickier about invalid sheet names and error handling. Here’s the adjusted version with safeguards:

Modified RenameWorksheets Code #

Sub RenameWorksheets()
    Dim rngAddress As String
    Dim ws As Worksheet
    Dim newName As String
    
    ' Get active cell address (relative format for consistency)
    rngAddress = ActiveCell.Address(False, False)
    
    For Each ws In ThisWorkbook.Worksheets
        ' Check for non-empty cell value
        If Not IsEmpty(ws.Range(rngAddress).Value) And Trim(ws.Range(rngAddress).Value) <> "" Then
            newName = Trim(ws.Range(rngAddress).Value)
            
            ' Clean invalid characters (Mac doesn't allow : / \ ? * [ ])
            newName = CleanSheetName(newName)
            
            ' Try to rename, catch errors for invalid/duplicate names
            On Error Resume Next
            ws.Name = newName
            If Err.Number <> 0 Then
                MsgBox "Failed to rename sheet '" & ws.Name & "' to '" & newName & "': " & Err.Description, vbCritical
                Err.Clear
            End If
            On Error GoTo 0
        End If
    Next ws
End Sub

' Helper to remove invalid characters from sheet names
Function CleanSheetName(name As String) As String
    Dim invalidChars As Variant
    invalidChars = Array(":", "/", "\", "?", "*", "[", "]")
    
    Dim char As Variant
    For Each char In invalidChars
        name = Replace(name, char, "")
    Next char
    
    ' Trim to Excel's 31-character limit
    If Len(name) > 31 Then
        name = Left(name, 31)
    End If
    
    CleanSheetName = name
End Function

Key Fixes: #

• Added CleanSheetName() to strip characters that Mac Excel blocks from sheet names.
• Added error handling to catch duplicate or invalid names (a common Mac-specific issue).
• Used IsEmpty() and Trim() to reliably check for non-empty cell values.
• Used ThisWorkbook.Worksheets to ensure we’re targeting the correct workbook.

Final Tips: #

• Enable the Microsoft VBScript Regular Expressions 5.5 library in the VBA Editor (Tools > References) for the regex code to work.
• Test each macro step-by-step to catch edge cases specific to your SQL output.

内容的提问来源于stack exchange，提问作者Seth Robinson