问题描述
我整天都在编写这段代码，最终使所有功能都能正常工作.唯一的问题是，代码的运行速度确实很慢.考虑到它将在具有数千行的工作簿上使用，我想对此进行更改.我对vba极为陌生，因此此处可能存在错误或似乎是错误的捷径.我想我添加了一些方法可以加快速度，但我不知道是否还有其他方法可以解决.
I've been working on this code all day and have finally gotten everything to work perfectly. The only problem, is that the code does run pretty slow. Considering that it will be used on a workbook with thousands of rows I would like to change that. I am extremely new to vba so there is probably stuff in here that is wrong or seems like a bad shortcut. I think I added a couple of ways that could speed it up but i didnt know if anything else could be done.
Option Explicit
Public Sub CL_NC()
Dim lZeile As Long
With ThisWorkbook.Worksheets("Gesamt")
For lZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 And (InStr(.Range("B" & lZeile).Value, "ISO 9001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 14001") > 0 Or InStr(.Range("B" & lZeile).Value, "BS OHSAS 18001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 45001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 50001") > 0) Then
.Range("G" & lZeile).Value = "Malaysia IMS CL"
ElseIf InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 And InStr(.Range("C" & lZeile).Value, "IMS") > 0 Then
.Range("G" & lZeile).Value = "Malaysia IMS NC"
ElseIf InStr(.Range("D" & lZeile).Value, "Malaysia") > 0 Then
.Range("G" & lZeile).Value = "Malaysia " & .Range("C" & lZeile).Value & " NC"
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 And (InStr(.Range("B" & lZeile).Value, "ISO 9001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 14001") > 0 Or InStr(.Range("B" & lZeile).Value, "BS OHSAS 18001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 45001") > 0 Or InStr(.Range("B" & lZeile).Value, "ISO 50001") > 0) Then
.Range("G" & lZeile).Value = "Indonesien IMS CL"
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 And InStr(.Range("C" & lZeile).Value, "IMS") > 0 Then
.Range("G" & lZeile).Value = "Indonesien IMS NC"
ElseIf InStr(.Range("D" & lZeile).Value, "Indonesien") > 0 Then
.Range("G" & lZeile).Value = "Indonesien " & .Range("C" & lZeile).Value & " NC"
Else
.Range("G" & lZeile).Value = ""
End If
Next lZeile
End With
End Sub
这是表格的外观.G列应显示VBA结果.
This is how the table looks right now. Column G should show the VBA result.
@Damian:亲爱的达米安，您的帮助真的很棒.但恐怕，我需要您的再次援助……桌上有一些国家(例如，保加利亚)遵守与马来西亚和马来西亚相同的规则印度尼西亚，但此外，当B列中的条目="ISO 22000"(在这种情况下，C列中的条目为"Food")时，它们也应标记为"Bulgaria Food CL".也可以在此代码中解决吗?提前非常感谢您！
@Damian: Dear Damian, your help here was really fantastic. But I am afraid, I need your assistance once again… I have some countries in the table (i.e. Bulgaria") which obey to the same rules as Malaysia & Indonesia, but additionally they should also be marked as „Bulgaria Food CL" when the entry in the column B = „ISO 22000" (in this case the entry in column C is „Food"). Can it also be solved within this code? Thank you so much in advance!
推荐答案
如果我没事的话，这应该在几秒钟内完成:
If I got it all right, this should do the trick in seconds:
Option Explicit
Public Sub CL_NC()
'Looks like your whole range is between A:G columns, so we insert that data
'inside the array
With ThisWorkbook.Worksheets("Gesamt")
'Last row
Dim i As Long: i = .Cells(.Rows.Count, 1).End(xlUp).Row
'insert your data into the array
Dim arr As Variant: arr = .Range("A1:G" & i).Value
'Declare a Country variable
Dim Country As String
'Loop through row 2 to the last (inside the array
For i = 2 To UBound(arr)
'Check which country we have
Select Case GetString(arr(i, 4))
Case "Malaysia"
Country = "Malaysia"
Case "Indonesien"
Country = "Indonesien"
Case Else
arr(i, 7) = vbNullString
GoTo NextRow
End Select
'Check which ISO we have
Select Case GetString(arr(i, 2))
Case "ISO 9001", "ISO 14001", "BS OHSAS 18001", "ISO 45001", "ISO 50001"
Country = Country & " IMS CL"
Case Else
If arr(i, 3) Like "*IMS*" Then
Country = Country & " IMS NC"
Else
Country = Country & " " & arr(i, 3) & " NC"
End If
End Select
arr(i, 7) = Country
NextRow:
Next i
.AutofilterMode = False
i = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:G" & i).Value = arr
End With
End Sub
Private Function GetString(ByVal KeyValue As String) As String
'Helper function to extract they key value for the strings
'You can add as much as you need with Else If
If KeyValue Like "*Malaysia*" Then
GetString = "Malaysia"
ElseIf KeyValue Like "*Indonesien*" Then
GetString = "Indonesien"
ElseIf KeyValue Like "*ISO 9001*" Then
GetString = "ISO 9001"
ElseIf KeyValue Like "*ISO 14001*" Then
GetString = "ISO 14001"
ElseIf KeyValue Like "*ISO 45001*" Then
GetString = "ISO 45001"
ElseIf KeyValue Like "*BS OHSAS 18001*" Then
GetString = "BS OHSAS 18001"
ElseIf KeyValue Like "*ISO 50001*" Then
GetString = "ISO 50001"
End If
End Function
这篇关于在VBA中加速多个ElseIf查询的方法的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！