使用嵌套的IF语句导入

时间：2015-03-04 13:36:35

标签： vba excel-vba excel

我遇到以下代码的一些问题。我已经让主块运行得非常好，但是，当我添加额外的if语句时，我现在得到一个excel挂起。我知道这与我的if语句有关，但我不太了解我所做的事情。 任何帮助非常感谢。

Sub Import()
' Prevent screen from updating & define "directory" and "Filename"
Application.ScreenUpdating = False
Application.CalculateFull
directory = "T:\JLR Project 2013\Joint Data\CHEATSHEETS\"
Filename = (directory & Cells(10, 16))

' Define Object for Target Workbook
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String
Dim sh As Worksheet
Dim myPassword As String
myPassword = Password1.Password.Value
' ------- REMOVE PASSWORD -------

' Assign the Workbook File Name along with its Path
' Change path of the Target File name
Target_Path = Filename
Set Target_Workbook = Workbooks.Open(Target_Path)
' Unprotect the sheet so as to remove information
For Each sh In ActiveWorkbook.Worksheets
    sh.Unprotect Password:=myPassword
Next sh
Set Source_Workbook = ThisWorkbook
' Cheatsheet Rev 10
If Range("A22") = "Input" Then
    ' Select Force from sheet and copy
    Target_Data = Target_Workbook.Sheets(1).Range("c22")
    ' Paste Force into the big sheet
    Source_Workbook.Sheets(1).Range("h19") = Target_Data
    ' Select Head Height DTI
    Target_Data = Target_Workbook.Sheets(1).Range("e17:e21")
    Source_Workbook.Sheets(1).Range("c33:c37") = Target_Data
    ' Select Head Height Macro
    Target_Data = Target_Workbook.Sheets(1).Range("g17:g21")
    Source_Workbook.Sheets(1).Range("d33:d37") = Target_Data
    ' Select Interlock
    Target_Data = Target_Workbook.Sheets(1).Range("i17:j21")
    Source_Workbook.Sheets(1).Range("e33:f37") = Target_Data
    ' Select T-Min
    Target_Data = Target_Workbook.Sheets(1).Range("m17:m21")
    Source_Workbook.Sheets(1).Range("h33:h37") = Target_Data
    ' Select Parameters, cracks through etc
    Target_Data = Target_Workbook.Sheets(1).Range("o17:s21")
    Source_Workbook.Sheets(1).Range("c49:g53") = Target_Data
Else

' Cheatsheet Rev 9
If Range("C15") = "Peak Force" Then
    ' Select Force from sheet and copy
    Target_Data = Target_Workbook.Sheets(1).Range("C25")
    Source_Workbook.Sheets(1).Range("h19") = Target_Data
    ' Select Head Height DTI
    Target_Data = Target_Workbook.Sheets(1).Range("e17:e21")
    Source_Workbook.Sheets(1).Range("c33:c37") = Target_Data
    ' Select Head Height Macro
    Target_Data = Target_Workbook.Sheets(1).Range("g17:g21")
    Source_Workbook.Sheets(1).Range("d33:d37") = Target_Data
    ' Select Interlock
    Target_Data = Target_Workbook.Sheets(1).Range("i17:j21")
    Source_Workbook.Sheets(1).Range("e33:f37") = Target_Data
    ' Select T-Min
    Target_Data = Target_Workbook.Sheets(1).Range("m17:m21")
    Source_Workbook.Sheets(1).Range("h33:h37") = Target_Data
    ' Select Parameters, cracks through etc
    Target_Data = Target_Workbook.Sheets(1).Range("o17:s21")
    Source_Workbook.Sheets(1).Range("c49:g53") = Target_Data
Else

' Cheatsheet Rev 6
If Range("M15") = "Peak Force" Then
    ' Select Force from sheet and copy
    Target_Data = Target_Workbook.Sheets(1).Range("M23")
    ' Paste Force into the big sheet
    Source_Workbook.Sheets(1).Range("h19") = Target_Data
    Target_Data = Target_Workbook.Sheets(1).Range("C17:C21")
    Source_Workbook.Sheets(1).Range("c33:c37") = Target_Data
    Target_Data = Target_Workbook.Sheets(1).Range("E17:E21")
    Source_Workbook.Sheets(1).Range("d33:d37") = Target_Data
    Target_Data = Target_Workbook.Sheets(1).Range("G17:H21")
    Source_Workbook.Sheets(1).Range("e33:f37") = Target_Data
    Target_Data = Target_Workbook.Sheets(1).Range("K17:K21")
    Source_Workbook.Sheets(1).Range("h33:h37") = Target_Data
    Target_Data = Target_Workbook.Sheets(1).Range("N17:R21")
    Source_Workbook.Sheets(1).Range("c49:g53") = Target_Data
Else

' Cheatsheet Rev 4
If Range("M15") = "Cracks Through to Rivet?" Then
    ' Select Force from sheet and copy
    Source_Workbook.Sheets(1).Range("h19") = "--"
    ' Select Head Height DTI
    Target_Data = Target_Workbook.Sheets(1).Range("C17:C21")
    Source_Workbook.Sheets(1).Range("c33:c37") = Target_Data
    ' Select Head Height Macro
    Target_Data = Target_Workbook.Sheets(1).Range("E17:E21")
    Source_Workbook.Sheets(1).Range("d33:d37") = Target_Data
    ' Select Interlock
    Target_Data = Target_Workbook.Sheets(1).Range("G17:H21")
    Source_Workbook.Sheets(1).Range("e33:f37") = Target_Data
    ' Select T-Min
    Target_Data = Target_Workbook.Sheets(1).Range("K17:K21")
    Source_Workbook.Sheets(1).Range("h33:h37") = Target_Data
    ' Select Parameters, cracks through etc
    Target_Data = Target_Workbook.Sheets(1).Range("M17:Q21")
    Source_Workbook.Sheets(1).Range("c49:g53") = Target_Data
Else

' Cheatsheet Rev 2
If Range("M15") = "" Then
    ' Select Force from sheet and copy
    Source_Workbook.Sheets(1).Range("h19") = "--"
    ' Select Head Height DTI
    Target_Data = Target_Workbook.Sheets(1).Range("C17:C21")
    Source_Workbook.Sheets(1).Range("c33:c37") = Target_Data
    ' Select Head Height Macro
    Target_Data = Target_Workbook.Sheets(1).Range("E17:E21")
    Source_Workbook.Sheets(1).Range("d33:d37") = Target_Data
    ' Select Interlock
    Target_Data = Target_Workbook.Sheets(1).Range("G17:H21")
    Source_Workbook.Sheets(1).Range("e33:f37") = Target_Data
    ' Select T-Min
    Target_Data = Target_Workbook.Sheets(1).Range("K17:K21")
    Source_Workbook.Sheets(1).Range("h33:h37") = Target_Data
    ' Select Parameters, cracks through etc
    Source_Workbook.Sheets(1).Range("c49:g53") = "--"
Else
MsgBox "ERROR FILE NOT SUPPORTED"

' Re-protect the workbook
For Each sh In ActiveWorkbook.Worksheets
    sh.Protect Password:=myPassword
Next sh
' Save any changes in the two workbooks
Source_Workbook.Save
Target_Workbook.Save
Target_Workbook.Close False

' Re-calculate all of the sheets within the targate workbook to allow images to be imported
Application.CalculateFull

Image

' Process Completed
MsgBox "Import Complete"

End If
End Sub

2 个答案:

答案 0 :(得分：1)

每次你有：

Else

' Cheatsheet Rev 9
If Range("C15") = "Peak Force" Then

尝试将Else ... If替换为ElseIf（一句话）：

...
' Cheatsheet Rev 9
ElseIf Range("C15") = "Peak Force" Then
...

但我不知道你要把你的End If指示放在哪里......

答案 1 :(得分：0)

替代Rubik完全可以接受的方法：

If Range("A22") = "Input" Then
  'stuff
Else
  If Range("C15") = "Peak Force" Then
    'stuff
  Else
    If Range("M15") = "Peak Force" Then
      'stuff
    Else
      If Range("M15") = "Cracks Through to Rivet?" Then
        'stuff
      Else
        If Range("M15") = "" Then
          'stuff
        Else
          MsgBox "ERROR FILE NOT SUPPORTED"
'This is the critical difference to your code:
        End if
      End if
    End if
  End if
End if
' Re-protect the workbook
'and the rest of your code here - be sure to get rid of the now random
'End If that would be down there

如果您只是将所有End If添加到您现在所拥有的位置，您会发现只会重新保护工作表＆amp;保存更改如果您第一次看到ERROR FILE NOT SUPPORTED消息。

相关问题
最新问题