我有两个工作簿，将它们称为A和B。A中有我的VBA宏，B中有我要在其上运行宏的数据。我同时打开了两个工作表，当我转到Excel（工作簿A）中的“宏”按钮并尝试在工作簿B中运行宏时，单击“运行”，然后什么也没有发生。这两个文件都保存为.xlsm，使用宏没有任何限制。
我什至将VBA代码从工作簿B复制到工作簿A，并尝试直接运行它，但是它什么也没做。
我知道VBA宏很好，因为我可以直接在Workbook B中运行它，并在Workbook B中运行数据。我之前已经做过，而且工作正常。 VBA宏也是Public。我想念什么？我正在运行Office 365客户端。
编辑：下面提供的代码。同样，这在原始工作簿中已经可以正常运行，并且在过去从其他工作簿运行时也可以正常工作。
Public lstrow As Long, strDate As Variant, stredate As Variant
Sub importbuild()
Application.ScreenUpdating = False
'Define last row of exported data
lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row
Worksheets("Data").Cells.Replace what:="=", Replacement:="", _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
'Run function to build import file for Hepatitis Immunizations
Call HepLoad("O", "P", "HB1")
Call HepLoad("Q", "R", "HB2")
Call HepLoad("S", "T", "HB3")
Call HepLoad("U", "V", "HB1")
Call HepLoad("W", "X", "HB2")
Call HepLoad("Y", "NA", "HB3")
'Run function for Hepatitis Series Completed
Call HepSeries("Z", "AA")
'Run function for Titers
Call Titer("AB", "AC", "HT")
Call Titer("AD", "AE", "RT")
Call Titer("AF", "AG", "UT")
Call Titer("AH", "AI", "VT")
'Run functions for Varicella Immunizations
Call DateOnlyLoad("AJ", "AK", "VAR1")
Call DateOnlyLoad("AL", "NA", "VAR2")
'Run function for Tetanus Immunizations
Call TetanusLoad("AM", "AN")
'Run function for MMR Immunizations
Call DateOnlyLoad("AO", "AP", "MMR1")
Call DateOnlyLoad("AQ", "NA", "MMR2")
'Call BCGLoad("BA", "NA", "BCG")
Call PPDdate
Application.ScreenUpdating = True
End Sub
Function HepLoad(col As String, col2 As String, colcode As String)
Dim i As Long, j As Long, k As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
If (Len(strDate) = 0 And Len(stredate) = 0) Or (colcode = "HB1" And Len(strDate) <> 0 And InStr(1, UCase(Worksheets("Data").Range("AA" & i).Value), "DECL") > 0) Then
GoTo EmptyRange
Else
strDate = spacedate(Worksheets("Data").Range(col & i).Value)
stredate = spacedate(Worksheets("Data").Range(col2 & i).Value)
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
'Emailed issue of TwinRX referencing HepAB but only in Hep1Dt, not Hep2Dt or Hep3Dt
If InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "TWIN") > 0 Then
Worksheets("CI").Range("D" & j).Value = colcode
Else
Worksheets("CI").Range("D" & j).Value = colcode
End If
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
Worksheets("CI").Range("F" & j).Value = RemoveChars(datecleanup(stredate))
If col2 <> "NA" Then
If IsEmpty(stredate) = False Then
Worksheets("CI").Range("G" & j).Value = datecleanup(stredate)
End If
End If
j = j + 1
End If
EmptyRange:
Next i
End Function
Function DateOnlyLoad(col As String, col2 As String, colcode As String)
Dim i As Long, j As Long, k As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
strDate = spacedate(Worksheets("Data").Range(col & i).Value)
stredate = spacedate(Worksheets("Data").Range(col2 & i).Value)
If (Len(strDate) = 0 And (col2 = "NA" Or Len(stredate) = 0)) Or InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "EXP") > 0 Then
GoTo EmptyRange
Else
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
'If InStr(1, UCase(Worksheets("Data").Range(col & i).Value), "TITER") > 0 Then
'Worksheets("Error").Range("A" & k & ":C" & k).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
'Worksheets("Error").Range("D" & k).Value = "REVIEW MMR1 DATES"
'k = k + 1
'Else
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
Worksheets("CI").Range("L" & j).Value = dateclean(strDate)
Worksheets("CI").Range("M" & j).Value = strDate
'Worksheets("CI").Range("N" & j).Value = RemoveChars(datecleanup(strDate))
Worksheets("CI").Range("N" & j).Value = RemoveChars(strDate)
Worksheets("CI").Range("O" & j).Value = datecleanup(RemoveChars(strDate))
If col2 <> "NA" Then
If IsEmpty(stredate) = False Then
Worksheets("CI").Range("F" & j).Value = RemoveChars(datecleanup(stredate))
'Worksheets("CI").Range("F" & j).Value = datecleanup(stredate)
End If
End If
j = j + 1
'End If
End If
EmptyRange:
Next i
End Function
Function BCGLoad(col As String, colcode As String)
Dim i As Long, j As Long, k As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
If Worksheets("Data").Range(col & i).Value = "Yes" Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode
Worksheets("CI").Range("E" & j).Value = "01/01/1901"
j = j + 1
End If
Next i
End Function
Function HepSeries(col As String, col2 As String)
Dim i As Long, j As Long, k As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
If InStr(1, UCase(Worksheets("Data").Range(col2 & i).Value), "DECL") > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = "HSD"
'If no declination date (placed in Hep1Dt column per Carolyn) load 01/01/1901
If Len(Worksheets("Data").Range("O" & i).Value) = 0 Then
Worksheets("CI").Range("E" & j).Value = "01/01/1901"
Else
Worksheets("CI").Range("E" & j).Value = Worksheets("Data").Range("O" & i).Value
End If
j = j + 1
Else
If Worksheets("Data").Range(col & i).Value = "Yes" Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = "HSC"
If Len(Worksheets("Data").Range(col2 & i).Value) = 4 Then
Worksheets("CI").Range("E" & j).Value = "01/01/" & Worksheets("Data").Range(col2 & i).Value
Else
Worksheets("CI").Range("E" & j).Value = Worksheets("Data").Range(col2 & i).Value
End If
j = j + 1
Else
If IsEmpty(Worksheets("Data").Range(col & i).Value) = True And IsEmpty(Worksheets("Data").Range(col2 & i).Value) = True Then
GoTo EmptyRange
Else
Worksheets("Error").Range("A" & k & ":C" & k).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("Error").Range("D" & k).Value = "REVIEW HEP SERIES COMPLETION"
Worksheets("Error").Range("E" & k).Value = Worksheets("Data").Range(col & i).Value
Worksheets("Error").Range("F" & k).Value = Worksheets("Data").Range(col2 & i).Value
k = k + 1
End If
End If
End If
EmptyRange:
Next i
End Function
Function Titer(col As String, col2 As String, colcode As String)
Dim i As Long, j As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
strresult = UCase(Worksheets("Data").Range(col & i).Value)
strDate = Worksheets("Data").Range(col2 & i).Value
'Carolyn advised if field is EXP CAT #1/2 to ignore
If (Len(strresult) = 0 And Len(strDate) = 0) Or InStr(1, strresult, "EXP") + InStr(1, strresult, "CAT") > 0 Then
GoTo EndRange
Else
'Positive - check if mumps is in string
If InStr(1, strresult, "POS") > 0 And (InStr(1, strresult, "HX") + InStr(1, strresult, "HIS")) = 0 Then
If InStr(1, strresult, "MUMP") = 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "PS"
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
Else
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = "MTPS"
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
End If
j = j + 1
GoTo EndRange
End If
'History of Disease - Not documented
If InStr(1, strresult, "DOC") = 0 And (InStr(1, strresult, "HX") + InStr(1, strresult, "HIS")) > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "PH"
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
End If
'Documented history of disease
If InStr(1, strresult, "DOC") > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "DH"
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
End If
'Negative result, doesn't show declined
If InStr(1, strresult, "NEG") > 0 And InStr(1, strresult, "DEC") = 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "NG"
'ChangeFlag: Date load for declination pending Carolyn's approval
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
End If
'Age Exempt
If InStr(1, strresult, "AGE") > 0 Or InStr(1, strresult, "BIRTH") > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "AE"
'ChangeFlag: Date load for declination pending Carolyn's approval
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
End If
'Declined
If InStr(1, strresult, "DEC") > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("D" & j).Value = colcode & "DE"
'ChangeFlag: Date load for declination pending Carolyn's approval
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
j = j + 1
GoTo EndRange
End If
'No titer
'If InStr(1, strresult, "NO TITER") > 0 Then
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
'Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("F" & i & ":H" & i).Value
'Worksheets("CI").Range("D" & j).Value = colcode & "NO"
'ChangeFlag: Date load for declination pending Carolyn's approval
'Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
'j = j + 1
'GoTo EndRange
'End If
'Undefined result, add to error page
Worksheets("Error").Range("A" & k & ":C" & k).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("Error").Range("D" & k).Value = "REVIEW " & colcode & " TITER ERROR"
Worksheets("Error").Range("E" & k).Value = strresult
Worksheets("Error").Range("F" & k).Value = strDate
k = k + 1
End If
EndRange:
Next i
End Function
Function TetanusLoad(col As String, col2 As String)
Dim i As Long, j As Long, k As Long
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
If Len(Worksheets("Data").Range(col & i).Value) = 0 And Len(Worksheets("Data").Range(col2 & i).Value) = 0 Then
GoTo EmptyRange
Else
strDate = spacedate(Worksheets("Data").Range(col & i).Value)
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Select Case Worksheets("Data").Range(col2 & i).Value
Case "Tdap"
Worksheets("CI").Range("D" & j).Value = "TDA"
Case "Td"
Worksheets("CI").Range("D" & j).Value = "TD"
Case Else
Worksheets("CI").Range("D" & j).Value = "REVIEW"
End Select
Worksheets("CI").Range("E" & j).Value = datecleanup(strDate)
'Worksheets("CI").Range("I" & j).Value = FormatOutput(strDate)
Worksheets("CI").Range("L" & j).Value = dateclean(strDate)
j = j + 1
End If
EmptyRange:
Next i
End Function
Sub InfluenzaLoad()
Dim i As Long, j As Long, k As Long
Dim rngFluShot As Range, rngEggFree As Range, rngAller As Range
Dim rngFluDec As Range, rngFluDecDate As Range, strFluCode As String
lstrow = Worksheets("Data").Range("G" & Rows.Count).End(xlUp).Row
j = Worksheets("CI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
Set rngFluShot = Worksheets("Data").Range("BH" & i)
Set rngEggFree = Worksheets("Data").Range("BI" & i)
Set rngAller = Worksheets("Data").Range("BJ" & i)
Set rngFluDec = Worksheets("Data").Range("BK" & i)
Set rngFluDecDate = Worksheets("Data").Range("BL" & i)
If Len(rngFluShot.Value) = 0 And Len(rngFluDecDate.Value) = 0 Then
GoTo NoRecord:
Else
If Len(rngFluShot.Value) > 0 And Len(rngFluDecDate.Value) = 0 Then
Select Case True
Case Len(rngEggFree.Value) = 0 And Len(rngFluDec.Value) = 0
strFluCode = "FLQS"
Case InStr(1, rngEggFree.Value, "EGG FREE") > 0
strFluCode = "FLEG"
Case InStr(1, rngFluDec.Value, "FLUCEL") > 0
strFluCode = "FLSY"
Case InStr(1, rngFluDec.Value, "INTRA") > 0
strFluCode = "FLI"
End Select
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("E" & j).Value = datecleanup(rngFluShot.Value)
If Right(rngFluShot.Value, 4) = "2017" Or Right(rngFluShot.Value, 4) = "2018" Then
Worksheets("CI").Range("F" & j).Value = "4/30/2018"
End If
Worksheets("CI").Range("D" & j).Value = strFluCode
Else
Select Case True
Case InStr(1, UCase(rngFluDec.Value), "MED") > 0
strFluCode = "FLDM"
Case InStr(1, UCase(rngFluDec.Value), "REL") > 0
strFluCode = "FLDR"
Case Else
strFluCode = "FLDU"
End Select
'ChangeNeed
'Needs to be changed to reflect John's corrected PS ID field ("B")
Worksheets("CI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("CI").Range("E" & j).Value = datecleanup(rngFluDecDate.Value)
If Right(rngFluDecDate.Value, 4) = "2017" Or Right(rngFluDecDate.Value, 4) = "2018" Then
Worksheets("CI").Range("F" & j).Value = "4/30/2018"
End If
Worksheets("CI").Range("D" & j).Value = strFluCode
End If
j = j + 1
End If
NoRecord:
Next i
End Sub
Function datecleanup(inputdate As Variant) As Variant
If Len(inputdate) = 0 Then
inputdate = "01/01/1901"
Else
If Len(inputdate) = 4 Then
inputdate = "01/01/" & inputdate
Else
If InStr(1, inputdate, ".") Then
inputdate = Replace(inputdate, ".", "/")
End If
End If
End If
datecleanup = Split(inputdate, Chr(32))(0)
'dateclean1 = Split(strInput, Chr(32))(0)
'datecleanup = inputdate = dateclean1
End Function
Function spacedate(inputdate As Variant) As Variant
If Len(inputdate) = 1 And InStr(1, inputdate, " ") Then
inputdate = ""
End If
spacedate = inputdate
End Function
Function PPDdate()
Dim PPD_1_Date As Date
Dim PPD_2_Date As Date
Dim i As Long, j As Long, k As Long
j = Worksheets("PPDCI").Range("A" & Rows.Count).End(xlUp).Row + 1
k = Worksheets("Error").Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lstrow
PPD_1_Date = Worksheets("Data").Range("AW" & i)
PPD_2_Date = Worksheets("Data").Range("BA" & i)
Entity = Worksheets("Data").Range("J" & i)
Dept = Worksheets("Data").Range("M" & i)
TSpot_Date = Worksheets("Data").Range("AS" & i)
If PPD_1_Date > PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_1_Date
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("AX" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("AZ" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = Worksheets("Data").Range("AY" & i).Value
j = j + 1
Else
If PPD_1_Date < PPD_2_Date Then
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = PPD_2_Date
'Worksheets("PPDCI").Range("G" & j).Value = "ELSE IF CONDITION"
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("BB" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("BD" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = Worksheets("Data").Range("BC" & i).Value
j = j + 1
Else
'If IsEmpty(Worksheets("Data").Range(PPD_1_Date & i).Value) = True And IsEmpty(Worksheets("Data").Range(PPD_2_Date & i).Value) = True Then
'GoTo EmptyRange
'Else
If (InStr(1, Entity, "Corning Hospital") Or InStr(1, Entity, "Guthrie Home Health") Or InStr(1, Entity, "Guthrie Hospice") Or InStr(1, Dept, "Volunteers")) And IsEmpty(TSpot_Date) = True Then
Worksheets("Error").Range("A" & k & ":H" & k).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("Error").Range("F" & k).Value = "REVIEW PPD DATA"
k = k + 1
Else
Worksheets("PPDCI").Range("A" & j & ":C" & j).Value = Worksheets("Data").Range("A" & i & ":C" & i).Value
Worksheets("PPDCI").Range("F" & j).Value = TSpot_Date
Worksheets("PPDCI").Range("G" & j).Value = Worksheets("Data").Range("AX" & i).Value
Worksheets("PPDCI").Range("H" & j).Value = Worksheets("Data").Range("AY" & i).Value
Worksheets("PPDCI").Range("I" & j).Value = "NO PPD DATES BUT HAS TSPOT DATE"
j = j + 1
End If
End If
End If
'EmptyRange:
'k = k + 1
Next i
End Function
Function dateclean(strInput) As String
dateclean = Split(strInput, Chr(32))(0)
End Function
Function RemoveChars(ByVal inputString As String) As String
Dim regex As Object, tempString As String
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "(\d{1,2}\/){2}\d{2,4}"
'.Pattern = "(0[1-9]|1[012])[- /.](0[1-9]|[12][0-9]|3[01])[- /.](19|20)[0-9]{2}"
End With
If regex.test(inputString) Then
RemoveChars = regex.Execute(inputString)(0)
Else
RemoveChars = inputString
End If
End Function
答案 0 :(得分：0)
我开始工作了，lstrow变量引用了我移动的一列，所以它只是在看旧的空白列。现在运行良好。