1255940250 【Excel(エクセル)VBA】についての質問です。(添付画像有)


行可変のA列並べ替え後、A列二行目から、A列最終行まで、添付画像の様に、自動で名前定義(挿入→名前→定義)をしていくソースをお願いします。
名前は、それぞれ最初のセルvalue値となります。

・ソースは、A列並べ替え部分からお願いします。(50音順)
・2行目から最終行迄ですが、空白行は無視してください。
・スペースだけのセルはありません。データの前後もスペースは入ってません。

よろしくお願いいたします。

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2009/10/19 17:17:32
  • 終了:2009/10/19 19:04:15

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/19 18:33:53

ポイント300pt

名前を定義する場合に問題となるのは、既に同じ名前がある場合と、名前として使えない文字列の場合があります。

その場合、メッセージボックスを出すようにしました。


Sub AddName()
    Dim lastRow As Long
    Dim r1 As Long
    Dim r2 As Long
    Dim Nam As Name
    Dim c As Integer
    
    Range("A2:A" & Rows.Count).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
        
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    r2 = 2
    
    On Error Resume Next
    
    For r1 = 3 To lastRow + 1
        If Cells(r1, 1).Value <> Cells(r1 - 1, 1).Value Then
            Set Nam = ActiveWorkbook.Names(Cells(r1 - 1, 1).Value)
            If Err <> 0 Then
                c = ActiveWorkbook.Names.Count
                ActiveWorkbook.Names.Add Name:=Cells(r1 - 1, 1).Value, RefersTo:="=" & _
                    ActiveSheet.Name & "!" & Range(Cells(r2, 1), Cells(r1 - 1, 1)).Address
                    
                If c = ActiveWorkbook.Names.Count Then
                    MsgBox Cells(r1 - 1, 1).Value & "は名前に設定できません"
                End If
                Err.Clear
            Else
                MsgBox Cells(r1 - 1, 1).Value & "は既に使われています"
            End If
            r2 = r1
        End If
    Next r1
End Sub

http://www.moug.net/tech/exvba/0050052.htm

id:pocon

毎度お世話になっております。

相変わらず美しいソースで感激です。

>既に同じ名前がある場合と、名前として使えない文字列の場合があります。

お気遣い恐れ入ります。m(__)m

外部データを読込み、更新するものなので、前の名前を一旦削除しなければイケないのですが

予約済みの名前もあるので、定義してある名前の全てを削除するという事も出来ないのですが、

任意の文字「あ」・「か」・「さ」が含まれていれば削除するという形は出来ましょうか?

よろしければ、そのソースもご教授いただけないでしょうか、スミマセン。

2009/10/19 18:50:13

その他の回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/19 18:33:53ここでベストアンサー

ポイント300pt

名前を定義する場合に問題となるのは、既に同じ名前がある場合と、名前として使えない文字列の場合があります。

その場合、メッセージボックスを出すようにしました。


Sub AddName()
    Dim lastRow As Long
    Dim r1 As Long
    Dim r2 As Long
    Dim Nam As Name
    Dim c As Integer
    
    Range("A2:A" & Rows.Count).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
        :=xlPinYin, DataOption1:=xlSortNormal
        
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    r2 = 2
    
    On Error Resume Next
    
    For r1 = 3 To lastRow + 1
        If Cells(r1, 1).Value <> Cells(r1 - 1, 1).Value Then
            Set Nam = ActiveWorkbook.Names(Cells(r1 - 1, 1).Value)
            If Err <> 0 Then
                c = ActiveWorkbook.Names.Count
                ActiveWorkbook.Names.Add Name:=Cells(r1 - 1, 1).Value, RefersTo:="=" & _
                    ActiveSheet.Name & "!" & Range(Cells(r2, 1), Cells(r1 - 1, 1)).Address
                    
                If c = ActiveWorkbook.Names.Count Then
                    MsgBox Cells(r1 - 1, 1).Value & "は名前に設定できません"
                End If
                Err.Clear
            Else
                MsgBox Cells(r1 - 1, 1).Value & "は既に使われています"
            End If
            r2 = r1
        End If
    Next r1
End Sub

http://www.moug.net/tech/exvba/0050052.htm

id:pocon

毎度お世話になっております。

相変わらず美しいソースで感激です。

>既に同じ名前がある場合と、名前として使えない文字列の場合があります。

お気遣い恐れ入ります。m(__)m

外部データを読込み、更新するものなので、前の名前を一旦削除しなければイケないのですが

予約済みの名前もあるので、定義してある名前の全てを削除するという事も出来ないのですが、

任意の文字「あ」・「か」・「さ」が含まれていれば削除するという形は出来ましょうか?

よろしければ、そのソースもご教授いただけないでしょうか、スミマセン。

2009/10/19 18:50:13
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/19 19:01:56

ポイント300pt

コードの最初に次のマクロを実行させればいいです。

Sub DelName()
    Dim Nam As Name
    
    For Each Nam In ActiveWorkbook.Names
        If InStr(1, Nam.Name, "あ") > 0 Or _
            InStr(1, Nam.Name, "か") > 0 Or _
            InStr(1, Nam.Name, "さ") > 0 Then
            Nam.Delete
        End If
    Next
End Sub

http://q.hatena.ne.jp/

id:pocon

あー、なるほどです。

ありがとうございます。m(__)m

2009/10/19 19:03:48

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません