3

特定の文字列 (たとえば、total で始まるすべての名前付き範囲) で始まる特定のワークシートに存在する名前付き範囲のリストを取得し、値を取得する方法は? 日付に基づいて宿泊費の小計と総計をしようとしています。日付グループに基づいて、各小計に一意の名前を割り当てます。次に、各小計に一意に割り当てた名前付き範囲に基づいて総計を計算するために、終了時にクリックする必要があるボタンがあります。

以下は、総計を行うために私が書いたコードです。

Sub btnTotal()

    Dim Total, LastRowNo As Long

    LastRowNo = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count

    Total = 0

    For Each N In ActiveWorkbook.Names
        Total = Total + IntFlight.Range(N.Name).Value
    Next N

    IntFlight.Range("$P" & LastRowNo).Select
    Selection.NumberFormat = "$* #,##0.00;$* (#,##0.00);$* ""-""??;@"
    With Selection
        .Font.Bold = True
    End With

    ActiveCell.FormulaR1C1 = Total

End Sub

注: "Total = Total + IntFlight.Range(N.Name).Value" の IntFlight は、ワークシートの名前です。

上記のコードの唯一の問題は、すべての名前付き範囲がワークブックに存在するように見えることです。指定された文字列と行番号 (total26: 行 26 からの小計を意味します) で始まる特定のワークシートに存在する名前付き範囲を見つけて、総計として合計する値を取得する必要があります。

これを行う方法はありますか？答えを見つけるために2日を費やしてきました。

事前に感謝します。

EDIT 1（ベリサリウスの助けを借りてCharles Williamsが提供するソリューション）：

これは、Charles Williams のコードで行ったことです。

Option Explicit
Option Compare Text

Sub btnIntFlightsGrandTotal()

    Dim Total, LastRowNo As Long
    LastRowNo = FindLastRowNo("International Flights")

    Dim oNM As Name
    Dim oSht As Worksheet
    Dim strStartString As String

    strStartString = "IntFlightsTotal"
    Set oSht = Worksheets("International Flights")

    For Each oNM In ActiveWorkbook.Names
        If oNM.Name Like strStartString & "*" Then
            If IsNameRefertoSheet(oSht, oNM) Then
                Total = Total + Worksheets("International Flights").Range(oNM.Name).Value
            End If
        End If
    Next oNM

    IntFlights.Range("$P" & LastRowNo).Select
    Selection.NumberFormat = "$* #,##0.00;$* (#,##0.00);$* ""-""??;@"
    With Selection
        .Font.Bold = True
    End With

    ActiveCell.FormulaR1C1 = Total

End Sub

Function FindLastRowNo(SheetName As String) As Long

    Dim oSheet As Worksheet
    Set oSheet = Worksheets(SheetName)

    FindLastRowNo = oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count

End Function

ご協力ありがとうございました。ここで、このスクリプトの独自のバージョンを作成する必要があります。

4

2 に答える 2

4

定義名が文字列で始まり、特定のワークシートとワークブックの使用範囲内の範囲を参照しているかどうかを確認するコードを次に示します。

Option Explicit
Option Compare Text
Sub FindNames()
    Dim oNM As Name
    Dim oSht As Worksheet
    Dim strStartString As String

    strStartString = "Total"
    Set oSht = Worksheets("TestSheet")

    For Each oNM In ActiveWorkbook.Names
        If oNM.Name Like strStartString & "*" Then
            If IsNameRefertoSheet(oSht, oNM) Then

                MsgBox oNM.Name
            End If
        End If
    Next oNM
End Sub

Function IsNameRefertoSheet(oSht As Worksheet, oNM As Name) As Boolean
    Dim oSheetRange As Range

    IsNameRefertoSheet = False
    On Error GoTo GoExit

    If Not oSht Is Nothing Then
        If Range(oNM.Name).Parent.Name = oSht.Name And _
           Range(oNM.Name).Parent.Parent.Name = oSht.Parent.Name Then
            Set oSheetRange = oSht.Range("A1").Resize(oSht.UsedRange.Row + oSht.UsedRange.Rows.Count - 1, oSht.UsedRange.Column + oSht.UsedRange.Columns.Count - 1)
            If Not Intersect(Range(oNM.Name), oSheetRange) Is Nothing Then IsNameRefertoSheet = True
            Set oSheetRange = Nothing
        End If
    End If

    Exit Function
GoExit:
End Function
于 2010-10-27T10:38:05.827 に答える
0

次の関数は、ワークブック内のすべての名前とその合計を出力します。

コードを実行するために必要な基本ブロックだと思います。 

Sub btnTotal()

    For Each N In ActiveWorkbook.Names
           MsgBox N.Name + " " + CStr(Application.WorksheetFunction.Sum(Range(N)))
    Next N
End Sub

編集

あなたのコメントに答える：

次のように名前を定義します。

代替テキスト

その場合 (そしてその場合のみ)、次のコードが機能します。

Sub btnTotal()

  For Each N In ActiveSheet.Names
     If (InStr(N.Name, "!Total") <> 0) Then
         MsgBox N.Name + " " + CStr(Application.WorksheetFunction.Sum(Range(N)))
     End If
  Next N
End Sub

名前のスコープを正しく定義しないと、コードに多くの余分な作業が必要になります。

編集 まだ Excel 2003 を使用していることを忘れていたので、このバージョンで名前のスコープを管理するためのアドインがここにあります。以下のスクリーン キャップを参照してください

代替テキスト

HTH

于 2010-10-27T05:03:14.430 に答える