0

私のコードでReferToRangeの問題を解決してください。例を添付しました。MAIN が呼び出されると、実行時エラー 1041 アプリケーション定義またはオブジェクト定義エラーが発生します。セルの値に応じて、コンボボックスの listfillrange を 3 つの名前付き範囲にリンクしています。3 つの範囲は動的です (オフセット式があります)。コンボボックスは名前付き範囲とは異なるシートです 助けてください

Sub MAIN()
Dim PT As Range
Dim i As Long

With Sheet3  ' Unique SPP
    setNames .Range("a6")
    Set PT = .Range("b1")
    i = 1
    Do Until PT = ""
        If .Range("a1").Value = PT.Value Then
            On Error Resume Next
            Sheet1.ComboBox1.ListFillRange = ThisWorkbook.Names("view" & i).Name
            If Err.Number = 1004 Then
                MsgBox "not defined name: view" & i
            ElseIf Err.Number <> 0 Then
                MsgBox "unexpected error: " & Err.Description
            End If
            On Error GoTo 0
        End If
        i = i + 1
        Set PT = PT.Offset(0, 1)
    Loop
End With
End Sub

Sub setNames(theTopLeft As Range)
    Dim theName As Name
    Dim nameStr As String
    Dim theRng As Range
    Dim i As Long
    Application.DisplayAlerts = False
    theTopLeft.CurrentRegion.CreateNames Top:=True, Left:=False, _
                Bottom:=False, Right:=False
    Application.DisplayAlerts = True
    For Each theName In ThisWorkbook.Names
        With theName.RefersToRange.Value
            For i = .Cells.Count To 1 Step -1
                If .Cells(i) <> "" Then Exit For
            Next
        End With
        If i <> 0 Then theName.RefersTo = theName.RefersToRange.Resize(i, 1)
    Next
End Sub
4

1 に答える 1

0

あなたのコードは必要以上に複雑に思えます。したがって、あなたがやろうとしていることを正しく理解しているなら、これは法案に合うはずです。

Sub MAIN()

Dim rC As Range
Dim rD As Range
Dim i As Long
Dim s As String

On Error GoTo errTrap

With Sheet3 'change to suit
    s = .Range("a1") 'heading to find
    Set rD = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell)) 'data row 6 and down
    Set rD = rD.Resize(, 3) '1st 3 columns only, change if required
    i = Application.Match(s, rD.Rows(1).Cells, 0) 'find heading
    Set rC = rD.Columns(i).Offset(1).Cells 'drop heading from column
    Set rC = .Range(rC(1), .Cells(.Rows.Count, rC.Column).End(xlUp)) 'to end of data
'       if column contains data, fill combo
    If rC(1).Row > rD.Row Then Sheet1.ComboBox1.ListFillRange = .Name & "!" & rC.Address
End With
Exit Sub
errTrap:
If Err.Number = 13 Then
    MsgBox "heading not found:  " & s
Else
    MsgBox "unexpected error: " & Err.Description
End If

End Sub

ここに画像の説明を入力

于 2013-11-14T01:27:13.363 に答える