VBA：替换数组元素
VBA: replacing array elements
编辑：根据评论，我将提供有关代码的更多详细信息。
代码思路是：
B6:E6 范围内存储了字符串（例如 B6 = "Actual Sales"、C6 = "SOP11 (2015)"、D6 = "SOP12 (2015)"、E6 = "SOP10 (2015)" ).
如果字符串不是 "Actual Sales"，我使用 "Mid" 函数计算整数。
完成后，计算出的整数将在数组中使用 BubbleSort 进行排序。
之后，我想link 排序的整数 (SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6) 与原始字符串 (cell_b6、cell_c6、cell_d6、cell_e6)。也就是说，SOP_key_B6和cell_b6是一一对应的，等等）
我想做上面的事情，因为我需要输入范围L30:O30 带字符串的排序数组 基于排序的整数。
我希望这能让想法变得清晰，因为它不是很复杂，但方法本身和代码让它有点令人沮丧（可能是因为我仍在学习 VB 编码）。
代码如下：
Sub Worksheet_Delta_Update()
'Variables
Dim wb As Workbook, ws_wk_dlt As Worksheet, ws_dash As Worksheet, cell_B6 As Variant, _
cell_C6 As Variant, cell_D6 As Variant, cell_E6 As Variant, SOP_key_B6 As Variant, _
SOP_key_C6 As Variant, SOP_key_D6 As Variant, SOP_key_E6 As Variant
'Referencing
Set wb = ThisWorkbook
Set ws_wk_dlt = wb.Worksheets("t")
Set ws_dash = wb.Worksheets("x")
'Values from pivot stored
cell_B6 = ws_wk_dlt.Range("B6").Value
cell_C6 = ws_wk_dlt.Range("C6").Value
cell_D6 = ws_wk_dlt.Range("D6").Value
cell_E6 = ws_wk_dlt.Range("E6").Value
'If len certain amount of characters then do option 1, or option 2
If cell_B6 <> "" Then
If Len(cell_B6) = 12 And cell_B6 <> "Actual Sales" Then
SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 8, 4))
ElseIf Len(cell_B6) = 11 And cell_B6 <> "Actual Sales" Then
SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 7, 4))
End If
End If
If cell_C6 <> "" Then
If Len(cell_C6) = 12 And cell_C6 <> "Actual Sales" Then
SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 8, 4))
ElseIf Len(cell_C6) = 11 And cell_C6 <> "Actual Sales" Then
SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 7, 4))
End If
End If
If cell_D6 <> "" Then
If Len(cell_D6) = 12 And cell_D6 <> "Actual Sales" Then
SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 8, 4))
ElseIf Len(cell_D6) = 11 And cell_D6 <> "Actual Sales" Then
SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 7, 4))
End If
End If
If cell_E6 <> "" Then
If Len(cell_E6) = 12 And cell_E6 <> "Actual Sales" Then
SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 8, 4))
ElseIf Len(cell_E6) = 11 And cell_E6 <> "Actual Sales" Then
SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 7, 4))
End If
End If
'Finding the Actual Sales and putting into L30
If cell_B6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_B6
ElseIf cell_C6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_C6
ElseIf cell_D6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_D6
ElseIf cell_E6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_E6
End If
'BubbleSort in Descending order
Dim ArrayToSort(0 To 4) As Variant
ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6
'Moving upwards because of -1
For j = UBound(ArrayToSort) - 1 To LBound(ArrayToSort) Step -1
'Starting at lowest
For i = LBound(ArrayToSort) To j
If ArrayToSort(i) > ArrayToSort(i + 1) Then
vTemp = ArrayToSort(i)
ArrayToSort(i) = ArrayToSort(i + 1)
ArrayToSort(i + 1) = vTemp
End If
Next i
Next j
'Put sorted array into the range
'But how to put the values linked to integers?
'E.g. SOP_key_B6 = cell_B6
ws_dash.Range("L30:O30").Value = ArrayToSort
End Sub
最有可能的解决方案是用正确的元素替换数组元素（即 SOP_key_B6 = cell_B6 等）？
您的代码有些地方臃肿，例如：
Dim ArrayToSort(0 To 4) As Variant
ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6
可以替换为
Dim ArrayToSort As Variant 'note lack of ()
ArrayToSort = Array(SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6)
就您的问题而言，您似乎需要使用集合。假设 SOP-key_ 值和 cell_ 值之间存在 one-to-one 对应关系（否则称它们为 "keys" 会产生误导），您可以执行以下操作：
Dim C As New Collection
C.Add cell_B6, CStr(SOP_key_B6)
C.Add cell_C6, CStr(SOP_key_C6)
C.Add cell_D6, CStr(SOP_key_D6)
C.Add cell_E6, CStr(SOP_key_E6)
然后，在排序 ArrayToSort 之后，有一个像这样的循环：
For i = 0 to 3
Range("L30").Offset(0,i).Value = C(CStr(ArrayToSort(i)))
Next i
我 认为 这就是您要查找的内容 -- 但代码似乎比较复杂，因此稍微简化一下可能不是一个坏主意。
编辑时：
由于您通过 添加 构建密钥的方式，您得到了重复的密钥请注意 SOP11(2015) 不同于 SOP10(2016) 但 11+2015 = 10 + 2016（均等于 2026）。相反——并置：112015 不是 102016。
此外，将密钥创建拆分为它自己的函数是有意义的（这样您就不会重复 4 次本质上相同的代码：
Function ExtractKey(s As Variant) As Long
Dim v As Variant, n As Long
v = Trim(s)
If v Like "*(*)" Then
n = Len(v)
v = Mid(v, n - 7, 7)
v = Replace(v, "(", "")
ExtractKey = CLng(v)
Else
ExtractKey = 0
End If
End Function
请注意，return 类型是 Long -- Integer 变量太容易溢出，无法用于 VBA。
然后 -- 这样的事情应该可行：
Sub Worksheet_Delta_Update()
Dim SourceRange As Range, TargetRange As Range
Dim i As Long, j As Long, minKey As Long, minAt As Long
Dim v As Variant
Dim C As New Collection
Set SourceRange = Worksheets("t").Range("B6:E6")
Set TargetRange = Worksheets("t").Range("L30:O30")
For i = 1 To 4
v = SourceRange.Cells(1, i).Value
C.Add Array(ExtractKey(v), v)
Next i
'transfer data
For i = 1 To 4
minAt = -1
For j = 1 To C.Count
If minAt = -1 Or C(j)(0) < minKey Then
minKey = C(j)(0)
minAt = j
End If
Next j
TargetRange.Cells(1, i).Value = C(minAt)(1)
C.Remove minAt
Next i
End Sub
通过以下修改修复了 Type mismatch error：
Function ExtractKey(s As Variant) As Long
Dim v As Variant, n As Long
v = Trim(s) 'remove spaces leave only spaces between words
If v Like "*(*)" Then 'if it's SOPXX (YYYY) then
n = Len(v) 'find number of the characters
If n = 11 Then
v = Mid(v, n - 7, 7) 'find the number of SOP + year in bracket
ElseIf n = 12 Then
v = Mid(v, n - 8, 8)
End If
v = Replace(v, "(", "") 'replace the brackets with nothing
v = Replace(v, " ", "")
ExtractKey = CLng(v) 'error WAS here
Else
ExtractKey = 0
End If
End Function
编辑：
添加了另外几行
If n = 11 Then
v = Right(v, 4) + Left(v, 1)
ElseIf n = 12 Then
v = Right(v, 4) + Left(v, 2)
End If
以上开关年份和编号（例如SOP12（2015）= 122015和开关201512之后）。这是因为 SOP12 (2014) 被放置在 之后 SOP10 (2015) 尽管它应该早于它的 2014 年。现在工作得很好 :)
编辑：根据评论，我将提供有关代码的更多详细信息。
代码思路是：
B6:E6 范围内存储了字符串（例如 B6 = "Actual Sales"、C6 = "SOP11 (2015)"、D6 = "SOP12 (2015)"、E6 = "SOP10 (2015)" ).
如果字符串不是 "Actual Sales"，我使用 "Mid" 函数计算整数。
完成后，计算出的整数将在数组中使用 BubbleSort 进行排序。
之后，我想link 排序的整数 (SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6) 与原始字符串 (cell_b6、cell_c6、cell_d6、cell_e6)。也就是说，SOP_key_B6和cell_b6是一一对应的，等等）
我想做上面的事情，因为我需要输入范围L30:O30 带字符串的排序数组 基于排序的整数。
我希望这能让想法变得清晰，因为它不是很复杂，但方法本身和代码让它有点令人沮丧（可能是因为我仍在学习 VB 编码）。
代码如下：
Sub Worksheet_Delta_Update()
'Variables
Dim wb As Workbook, ws_wk_dlt As Worksheet, ws_dash As Worksheet, cell_B6 As Variant, _
cell_C6 As Variant, cell_D6 As Variant, cell_E6 As Variant, SOP_key_B6 As Variant, _
SOP_key_C6 As Variant, SOP_key_D6 As Variant, SOP_key_E6 As Variant
'Referencing
Set wb = ThisWorkbook
Set ws_wk_dlt = wb.Worksheets("t")
Set ws_dash = wb.Worksheets("x")
'Values from pivot stored
cell_B6 = ws_wk_dlt.Range("B6").Value
cell_C6 = ws_wk_dlt.Range("C6").Value
cell_D6 = ws_wk_dlt.Range("D6").Value
cell_E6 = ws_wk_dlt.Range("E6").Value
'If len certain amount of characters then do option 1, or option 2
If cell_B6 <> "" Then
If Len(cell_B6) = 12 And cell_B6 <> "Actual Sales" Then
SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 8, 4))
ElseIf Len(cell_B6) = 11 And cell_B6 <> "Actual Sales" Then
SOP_key_B6 = CInt(Mid(cell_B6, 4, 2)) + CInt(Mid(cell_B6, 7, 4))
End If
End If
If cell_C6 <> "" Then
If Len(cell_C6) = 12 And cell_C6 <> "Actual Sales" Then
SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 8, 4))
ElseIf Len(cell_C6) = 11 And cell_C6 <> "Actual Sales" Then
SOP_key_C6 = CInt(Mid(cell_C6, 4, 2)) + CInt(Mid(cell_C6, 7, 4))
End If
End If
If cell_D6 <> "" Then
If Len(cell_D6) = 12 And cell_D6 <> "Actual Sales" Then
SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 8, 4))
ElseIf Len(cell_D6) = 11 And cell_D6 <> "Actual Sales" Then
SOP_key_D6 = CInt(Mid(cell_D6, 4, 2)) + CInt(Mid(cell_D6, 7, 4))
End If
End If
If cell_E6 <> "" Then
If Len(cell_E6) = 12 And cell_E6 <> "Actual Sales" Then
SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 8, 4))
ElseIf Len(cell_E6) = 11 And cell_E6 <> "Actual Sales" Then
SOP_key_E6 = CInt(Mid(cell_E6, 4, 2)) + CInt(Mid(cell_E6, 7, 4))
End If
End If
'Finding the Actual Sales and putting into L30
If cell_B6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_B6
ElseIf cell_C6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_C6
ElseIf cell_D6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_D6
ElseIf cell_E6 = "Actual Sales" Then
ws_dash.Range("L31").Value = cell_E6
End If
'BubbleSort in Descending order
Dim ArrayToSort(0 To 4) As Variant
ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6
'Moving upwards because of -1
For j = UBound(ArrayToSort) - 1 To LBound(ArrayToSort) Step -1
'Starting at lowest
For i = LBound(ArrayToSort) To j
If ArrayToSort(i) > ArrayToSort(i + 1) Then
vTemp = ArrayToSort(i)
ArrayToSort(i) = ArrayToSort(i + 1)
ArrayToSort(i + 1) = vTemp
End If
Next i
Next j
'Put sorted array into the range
'But how to put the values linked to integers?
'E.g. SOP_key_B6 = cell_B6
ws_dash.Range("L30:O30").Value = ArrayToSort
End Sub
最有可能的解决方案是用正确的元素替换数组元素（即 SOP_key_B6 = cell_B6 等）？
您的代码有些地方臃肿，例如：
Dim ArrayToSort(0 To 4) As Variant
ArrayToSort(0) = SOP_key_B6
ArrayToSort(1) = SOP_key_C6
ArrayToSort(2) = SOP_key_D6
ArrayToSort(3) = SOP_key_E6
可以替换为
Dim ArrayToSort As Variant 'note lack of ()
ArrayToSort = Array(SOP_key_B6, SOP_key_C6, SOP_key_D6, SOP_key_E6)
就您的问题而言，您似乎需要使用集合。假设 SOP-key_ 值和 cell_ 值之间存在 one-to-one 对应关系（否则称它们为 "keys" 会产生误导），您可以执行以下操作：
Dim C As New Collection
C.Add cell_B6, CStr(SOP_key_B6)
C.Add cell_C6, CStr(SOP_key_C6)
C.Add cell_D6, CStr(SOP_key_D6)
C.Add cell_E6, CStr(SOP_key_E6)
然后，在排序 ArrayToSort 之后，有一个像这样的循环：
For i = 0 to 3
Range("L30").Offset(0,i).Value = C(CStr(ArrayToSort(i)))
Next i
我 认为 这就是您要查找的内容 -- 但代码似乎比较复杂，因此稍微简化一下可能不是一个坏主意。
编辑时：
由于您通过 添加 构建密钥的方式，您得到了重复的密钥请注意 SOP11(2015) 不同于 SOP10(2016) 但 11+2015 = 10 + 2016（均等于 2026）。相反——并置：112015 不是 102016。
此外，将密钥创建拆分为它自己的函数是有意义的（这样您就不会重复 4 次本质上相同的代码：
Function ExtractKey(s As Variant) As Long
Dim v As Variant, n As Long
v = Trim(s)
If v Like "*(*)" Then
n = Len(v)
v = Mid(v, n - 7, 7)
v = Replace(v, "(", "")
ExtractKey = CLng(v)
Else
ExtractKey = 0
End If
End Function
请注意，return 类型是 Long -- Integer 变量太容易溢出，无法用于 VBA。
然后 -- 这样的事情应该可行：
Sub Worksheet_Delta_Update()
Dim SourceRange As Range, TargetRange As Range
Dim i As Long, j As Long, minKey As Long, minAt As Long
Dim v As Variant
Dim C As New Collection
Set SourceRange = Worksheets("t").Range("B6:E6")
Set TargetRange = Worksheets("t").Range("L30:O30")
For i = 1 To 4
v = SourceRange.Cells(1, i).Value
C.Add Array(ExtractKey(v), v)
Next i
'transfer data
For i = 1 To 4
minAt = -1
For j = 1 To C.Count
If minAt = -1 Or C(j)(0) < minKey Then
minKey = C(j)(0)
minAt = j
End If
Next j
TargetRange.Cells(1, i).Value = C(minAt)(1)
C.Remove minAt
Next i
End Sub
通过以下修改修复了 Type mismatch error：
Function ExtractKey(s As Variant) As Long
Dim v As Variant, n As Long
v = Trim(s) 'remove spaces leave only spaces between words
If v Like "*(*)" Then 'if it's SOPXX (YYYY) then
n = Len(v) 'find number of the characters
If n = 11 Then
v = Mid(v, n - 7, 7) 'find the number of SOP + year in bracket
ElseIf n = 12 Then
v = Mid(v, n - 8, 8)
End If
v = Replace(v, "(", "") 'replace the brackets with nothing
v = Replace(v, " ", "")
ExtractKey = CLng(v) 'error WAS here
Else
ExtractKey = 0
End If
End Function
编辑： 添加了另外几行
If n = 11 Then
v = Right(v, 4) + Left(v, 1)
ElseIf n = 12 Then
v = Right(v, 4) + Left(v, 2)
End If
以上开关年份和编号（例如SOP12（2015）= 122015和开关201512之后）。这是因为 SOP12 (2014) 被放置在 之后 SOP10 (2015) 尽管它应该早于它的 2014 年。现在工作得很好 :)