Question

我目前正在尝试创建一个数组，其中包括每月缩短为3个字母等等。＆＃34; JAN＆＃34;。但是，我喜欢为每个月分配一个特定范围，可用于粘贴值等。

我尝试了以下无效:(错误：下标超出范围）

Sub Button1_Click()
Dim celltxt As String
celltxt = Worksheets("FH EXPORT").range("A2").Text
Set ws = Worksheets("Report")
Set genRng = ws.range("B2:B10")
Dim MonthName As Variant
MonthName = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

months(1) = ws.range("E2:E10")
months(2) = ws.range("F2:F10")
months(3) = ws.range("G2:E10")
months(4) = ws.range("H2:H10")
months(5) = ws.range("I2:I10")
months(6) = ws.range("J2:J10")
months(7) = ws.range("K2:K10")
months(8) = ws.range("L2:L10")
months(9) = ws.range("M2:M10")
months(10) = ws.range("N2:N10")
months(11) = ws.range("O2:N10")
months(12) = ws.range("P2:P10")
If InStr(1, celltxt, "JAN") Then
months(1).Value = genRng.Value
ElseIf InStr(1, celltxt, "FEB") Then
months(2).Value = genRng.Value
Else
    MsgBox ("not found")
End If
End Sub

我尝试这个的全部原因实际上是避免为每个月创建一个if语句，也如代码所示。

Answer 1

像

这样的东西

版本1：更简单

Option Explicit

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames,  i As Long
    celltxt = Worksheets("FH EXPORT").Range("A2").Text
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    For i = LBound(MonthNames) To UBound(MonthNames)
      'split celltxt on the search string MonthNames(i) e.g. Jan and test to see if resultant array has more than 1 item (ubound indicates number) i.e. was able to split because was present
       ' add an Or in case celltxt is only 3 characters long and is a match e.g. celltxt is Jan only.
         If UBound(Split(LCase$(celltxt), LCase$(MonthNames(i)))) > 0 Or LCase$(celltxt) = LCase$(MonthNames(i)) Then
            ws.Range("E2:E10").Offset(, i) = genRng.Value
            End
        End If
    Next i
    MsgBox ("not found")
End Sub

版本2：

Option Explicit

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames, i As Long, found As Boolean
    celltxt = Worksheets("FH EXPORT").Range("A2").Text
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") '<==array holding the month abbreviations

    For i = LBound(MonthNames) To UBound(MonthNames) 'loop the entire array e.g. Jan, Feb
        On Error Resume Next 'prepare for if not found error being thrown
        If IsError(Application.WorksheetFunction.Find(LCase$(MonthNames(i)), LCase$(celltxt))) Then 'test if error returned i.e. value not found
            GoTo NextLine 'if error found then current array item e.g. Jan was not found so go to the line that says NextLine
        Else
            ws.Range("E2:E10").Offset(, i) = genRng.Value 'no error so we know found and can set
            End 'exit progam as found
        End If
ResumeLine:
    Next i
    If Not found Then MsgBox ("not found")
    Exit Sub
NextLine:   'this handles the error by clearing it and then sending the program back to loop to try again with next array item e.g. Feb
    Err.Clear 'clear error
    GoTo ResumeLine 'go back to next i
End Sub

版本3使用LCase $进行比较

Public Sub Button1_Click()

    Dim celltxt As String, ws As Worksheet, genRng As Range, MonthNames, i As Long
    celltxt = LCase$(Worksheets("FH EXPORT").Range("A2").Text)
    Set ws = Worksheets("Report")
    Set genRng = ws.Range("B2:B10")
    MonthNames = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    For i = LBound(MonthNames) To UBound(MonthNames)

        If InStr(1, celltxt, LCase$(MonthNames(i))) > 0 Then
            ws.Range("E2:E10").Offset(, i) = genRng.Value
            End
        End If
    Next i
    MsgBox ("not found")
End Sub

Answer 2

您确定需要阵列吗？你可以动态生成月份名称：

Dim celltxt As String
Dim genRng  As Range
Set genRng = ActiveSheet.Range("B2:B10")
Dim ws As Worksheet
Set ws = Worksheets("Report")
celltxt = Worksheets("FH EXPORT").range("A2").Text
For m_ = 1 To 12
    If (InStr(1, UCase(celltxt), UCase(Format(DateSerial(1, m_, 1), "mmm")))) > 0 Then
        ws.Range("D2:D10").Offset(0, m_).Value = genRng.Value
        Exit Sub
    End If
Next m_

说明：

m_ = 1

的示例

DateSerial（1，m_，1）

上面的行生成一个值为“1/1/2001”的日期对象

格式（DateSerial（1，m_，1），“mmm”）

上面的行生成“Jan”

UCase（格式（DateSerial（1，m_，1），“mmm”）

上面的行生成“JAN”

然后将A2单元格的大写值UCase(celltxt)与此“JAN”进行比较，并将您的范围相应地复制到目的地，从E列开始，由循环中的月份编号m_设置

<强>更新

如果单元格A2在短月内总是有3个字母，那么这是一个单行：

Worksheets("Report").Range("D2:D10").Offset(0, Month(DateValue(Right(Left(Split(Worksheets("FH EXPORT").Range("A2").Text, " ")(1), 5), 3) & " 1"))).Value = Worksheets("Report").Range("B2:B10").Value

带范围的月份数组

2 个答案: