2017-07-31 10 views
0

私は再びVBAコードの1つに苦しんでいます!検証を実行するために次のコードを作成しました。 - A1セルに値が見つからない場合は、別の開いているExcel WBを見つけて、日付をコピーして、プロセスを再開します。しかし、値が見つかった場合は、このプロセスが開始されます。私は正しい場所に "Else"を置いていないと感じています。どんな提案も大きな助けになります! 私が話しているELSEは、 "私を見つける"の下にあります。論理Excel以外のVBAで動作しない場合

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

「ELSE」とは何ですか? 'If​​ answer003 = vbYes Then'行ですか?また、 'F8'を使ってコードをステップ実行すれば、それが起こることを期待したらどこで' ELSE'をスキップしますか? – BruceWayne

+1

自分の好意を持ってください - あなたのコードを一貫してインデントする方法を学んでください。これらの問題をはるかに簡単に見つけることができます。 – YowE3K

+0

私は毎日のレポーティングを簡単にするために、まだVBAでかなり新しいです。 @BruceWayne - "FIND ME"の後のElseを探します Elseは に接続されているはずですIf IsEmpty(Range( "A1"))Then –

答えて

0

私はあなたがたときに実行したいコードの100%を確認していないが、それはあなたがIf answer003 = vbYes Then代わりのIf IsEmpty(Range("A1")) ThenElseブロックとして配置のコードを持つ場合だけであるならば、直後にそのコードを移動If answer003 = vbYes ThenEnd If

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 

     End If 

    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 
    '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 

注:私は、そのコードが現在の論理的意味があるかどうかはわかりません - 私はちょうどあなたが何をしているかを理解しようとせずにブロックを並び替えます。あなたの"Please check the Data Sheet. No value found in first row! Do you wish to find Cvent003 file in open workbooks and start process?"質問にユーザーが「いいえ」と答えた場合、何の意味もないことは特にわかりません。私。彼らが「いいえ」と答えると、あなたのコードはブックに保存されているとフラグを立てています。本当に適切ですか?

+0

痛みは残念ですが、このコードでは、セルA1が空白ではない場合に実行されますが、空白の場合は、データを目的のシートにコピーして停止します。 あなたの前のコメントに答えるには、いいえが選択されていれば、私はちょうどサブを終了し、そこに停止しても問題ありません! –

+0

@AkshaySachdev - あなたは 'A1'が本当に空であると思いますか、あるいは' '' 'に評価されている式を持っていると思いますか?また、 'F8'を使ってコードを1行ずつ見ることができます。なぜなら、おそらく条件が満たされているからです。 – BruceWayne

+0

このコードを 'Else'の一部として実行したくないので、常に実行しますか?もしそうなら、 'End If'の後に移動してください。 – YowE3K

関連する問題