Excel VBA – 多个条件和多个语句
我很新的VBA编码，需要一些帮助。 我正在寻找一个代码，根据differet单元格的值来select范围。
在我的工作表中，我有7个单元格，如果我想要select一个范围，可以给单元格一个“X”
如果I33 =“X”则selectA1：S31（I33有公式）
如果I34 =“X”则selectT1：AH31（I33有公式）
我有7这些….
我在找什么 如果I33，I34，I35，I36，I37，I38或I39中的一个或多个具有“X”，则应该select相应的区域（示例A1：S31，有7个不同的范围）。
谢谢你的帮助 ：-）
你可以试试这个
Option Explicit Sub main() Dim xRangeAdress As Range, rangesAddress() As Range, rangeToSelect As Range, cell As Range Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("X-Sheet") '<== change it as per your actual sheet name Set xRangeAdress = ws.Range("I33:I39") '<== set the range with "X" formulas: change "I33:I39" as per your actual needs Call SetRangeAddresses(rangesAddress(), ws) ' call the sub you demand the addresses settings to For Each cell In xRangeAdress 'loop through "X" cells If UCase(cell.Value) = "X" Then Set rangeToSelect = MyUnion(rangeToSelect, rangesAddress(cell.Row - 33 + 1)) ' if there's an "X" then update 'rangeToSelect' range with corresponding range Next cell rangeToSelect.Select End Sub Sub SetRangeAddresses(rangeArray() As Range, ws As Worksheet) ReDim rangeArray(1 To 7) As Range '<== resize the array to as many rows as cells with "X" formula With ws ' type in as many statements as cells with "X" formula Set rangeArray(1) = .Range("A1:S31") '<== adjust range #1 as per your actual needs Set rangeArray(2) = .Range("T1:AH31") '<== adjust range #2 as per your actual needs Set rangeArray(3) = .Range("AI1:AU31") '<== adjust range #3 as per your actual needs Set rangeArray(4) = .Range("AU1:BK31") '<== adjust range #4 as per your actual needs Set rangeArray(5) = .Range("BL1:BT31") '<== adjust range #5 as per your actual needs Set rangeArray(6) = .Range("BU1:CD31") '<== adjust range #6 as per your actual needs Set rangeArray(7) = .Range("CE1:CJ31") '<== adjust range #7 as per your actual needs End With End Sub Function MyUnion(rng1 As Range, rng2 As Range) As Range If rng1 Is Nothing Then Set MyUnion = rng2 Else Set MyUnion = Union(rng1, rng2) End If End Function 我添加了评论，让你学习和发展他的代码，为您的进一步的知识
只是有一个不同的解决scheme（关于你需要select其中之一）：
Option Explicit Function MainFull(Optional WS As Variant) As Range If VarType(WS) = 0 Then Set WS = ActiveSheet ElseIf VarType(WS) <> 9 Then Set WS = Sheets(WS) End If With WS Dim getRng As Variant, outRng As Range, i As Long getRng = WS.Range("I33:I39").Value For i = 1 To 7 If getRng(i, 1) = "x" Then If MainFull Is Nothing Then Set MainFull = .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1)) '<- change it to fit your needs Else Set MainFull = Union(MainFull, .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1))) '<- change it to fit your needs End If End If Next End With End Function
Function MainArray(Optional WS As Variant) As Variant If VarType(WS) = 0 Then Set WS = ActiveSheet ElseIf VarType(WS) <> 9 Then Set WS = Sheets(WS) End If With WS Dim getRng As Variant, outArr() As Variant, i As Long, j As Long getRng = WS.Range("I33:I39").Value i = Application.CountIf(WS.Range("I33:I39"), "x") If i = 0 Then Exit Function ReDim outArr(1 To i) For i = 1 To 7 If getRng(i, 1) = "x" Then j = j + 1 Set outArr(j) = .Range(Array("A1:S31", "T1:AL31", "AM1:BE31", "BF1:BX31", "BY1:CQ31", "CR1:DJ31", "DK1:EC31")(i - 1)) '<- change it to fit your needs End If Next End With MainArray = outArr End Function
MainFull返回所有标记范围的整个范围，而MainArray返回一个包含所有标记为“x”的范围的数组。
如何使用它 ：
对于MainFull您可以通过Set myRange = MainFull("Sheet1")来Set myRange = MainFull("Sheet1")范围。 这样它可以很容易地在另一个macros（子）内使用复制/粘贴到某个地方。
但是如果你需要重复这个过程每个设定的范围（用“x”标记），那么第二个子需要像：
Dim myRange As Variant For Each myRange In MainArray("Sheet1") .... Next
然后通过myRange做所有的事情。 如果您还有任何问题，请询问;）