我又回来了我的一个VBA代码！我创建了以下代码来执行验证 - 如果在单元格A1中找不到任何值，则找到另一个打开的Excel WB，复制日期并进一步恢复该过程。这是有效的，但是如果找到的值只是启动过程。我觉得我还没有放置一个＆＃34; Else＆＃34;在正确的地方，任何建议，将是一个很大的帮助！ 我正在谈论的ELSE在＆＃34;发现我＆＃34;。
Sub Cvent003_Uploads()
Sheets("Add File Here").Select
If IsEmpty(Range("A1")) Then
Worksheets("Master Mapper").Activate
Dim answer003 As Integer
answer003 = MsgBox("Please check the Data Sheet. No value found in first row! Do you wish to find Cvent003 file in open workbooks and start process?", vbYesNo + vbQuestion, "Review & Proceed")
If answer003 = vbYes Then
'Starts here
Dim wSheet As Worksheet
Dim wBook As Workbook
Dim rFound As Range
Dim bFound As Boolean
Dim lngLastRow2 As Long
On Error Resume Next
For Each wBook In Application.Workbooks
For Each wSheet In wBook.Worksheets
Set rFound = Nothing
Set rFound = wSheet.Range("D1:D2").Find(What:="Meeting Manager", SearchFormat:=True, After:=wSheet.Range("D1"), _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=True)
'rFound.Cells.Select
If Not rFound Is Nothing Then
bFound = True
Application.Goto rFound, True
'Rows(1, 2).EntireRow.Hidden = True
lngLastRow2 = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Range("A1:G" & lngLastRow2).Copy
ThisWorkbook.Worksheets("Add File Here").Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Exit For
End If
Next wSheet
If bFound = True Then Exit For
Next wBook
If rFound Is Nothing Then
MsgBox "No open file for Cvent003 Meetings Found. Make sure the most recent Cvent003 Excel WB is open!", vbCritical + vbOKOnly
Exit Sub
End If
'FIND ME
Else
Sheets("Add File Here").Select
Columns("A:A").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromRightOrAbove
Range("A1").Value = "Meeting Name"
Dim lngLastRow As Long
lngLastRow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Range("A2:A" & lngLastRow).Value = Evaluate("=C2:C" & lngLastRow & "&"" - ""&" & "B2:B" & lngLastRow)
Columns(2).EntireColumn.Delete
Columns("A").Replace _
What:=";", Replacement:=""
Columns("A").Replace _
What:=":", Replacement:=""
Columns("A").Replace _
What:=",", Replacement:=""
Columns("A").Replace _
What:="(", Replacement:=""
Columns("A").Replace _
What:=")", Replacement:=""
Columns("A").Replace _
What:="{", Replacement:=""
Columns("A").Replace _
What:="}", Replacement:=""
Columns("A").Replace _
What:="[", Replacement:=""
Columns("A").Replace _
What:="]", Replacement:=""
Columns("A").Replace _
What:="~+", Replacement:=""
Columns("A").Replace _
What:="~*", Replacement:=""
Columns("A").Replace _
What:="~?", Replacement:=""
Columns("A").Replace _
What:="_", Replacement:=""
Columns("A").Replace _
What:=".", Replacement:=""
Columns("A").Replace _
What:="'", Replacement:=""
Columns("A").Replace _
What:="\", Replacement:=""
Columns("A").Replace _
What:="/", Replacement:=""
Columns("A").Replace _
What:=".", Replacement:=""
Columns("A").Replace _
What:="@", Replacement:=""
Columns("A").Replace _
What:=Chr(34), Replacement:=""
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Client ID"
Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Value = "Planner Name"
Columns("J:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Value = "External System Name"
Dim rngID As Range
Dim PID As Long
Dim ClientID As Long
ClientID = Range("B2:B" & lngLastRow).Copy
'Set the range in column A you want to loop through
Set rngID = Range("B2:B500")
For Each cell In rngID
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
'Range("G2:G" & lngLastRow).Value.Copy
Range("C2:C" & lngLastRow).Value = Range("B2:B" & lngLastRow).Value
'cell.Offset(0, 1).Value = EndDate.PasteSpecial
End If
Next
Dim cellID As Range
For Each cell In ThisWorkbook.ActiveSheet.Range("C2:C" & lngLastRow)
'If Len(cell.Value) > 3 Then cell.Value = Left(cell.Value, 3)
cell.Value = Left(cell.Value, 3)
Next cell
Columns(6).EntireColumn.Delete
Dim rngP As Range
Dim Pi As Long
'Set the range in column A you want to loop through
Set rngP = Range("D2:D500")
For Each cell In rngP
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "NA"
End If
Next
Dim rngE As Range
Dim Ei As Long
'Set the range in column A you want to loop through
Set rngE = Range("H2:H500")
For Each cell In rngE
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "Cvent"
End If
Next
ThisWorkbook.ActiveSheet.Cells.Interior.ColorIndex = 0
Dim answer As Integer
answer = MsgBox("Temporary File Prepared for Cvent003. Do you wish to proceed with MMS_NewMtgs file creation?", vbYesNo + vbQuestion, "Review & Proceed")
If answer = vbYes Then
Call Prepare_OutputFile
Else
MsgBox "Output file not created!! Please select - Click to create MMS Formatted File from Master Mapper.", vbOKOnly
End If
End If
End If
'MsgBox "File has been formatted for Cvent002 and is ready for MMS upload. Please copy values and paste to Standard Format File on your system!", vbOKOnly
ThisWorkbook.Saved = True
End Sub
答案 0 :(得分：0)
我不是100％确定您要执行的代码，但是如果只是将代码放置为<*> f块代替Else的情况然后只需在If answer003 = vbYes Then If IsEmpty(Range("A1")) Then之后移动该代码：
End If注意：我不知道代码现在是否具有逻辑意义 - 我只是重新安排了块而不试图理解你在做什么。如果用户对您的If answer003 = vbYes Then问题回答“否”，我特别不确定无效的含义是什么。即如果他们回答“否”，那么您的代码会将工作簿标记为已保存 - 这是否真的合适？