Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Excel 2016)
名前のリストを作成
投稿日時: 19/12/24 12:51:09
投稿者: chokobanana

先ほどの続きで
シート名集計のJ列をシート名リストにリスト形式で表示するようにしたいです。
 
マクロの記録から少し修正したらエラーが出てしまいました。
 
(マクロの記録)
1.シート集計のJ列をコピー
2.シートリストのJ列貼りつけ
3.データ→入力規則で
 シートリストのJ列をもとに、シートリストのC列をリスト形式にする
 
(エラー)
エラー箇所:b.Range("J2").PasteSpecial Paste
      実行時エラー1004 RangeクラスのPasteSpecialメソッドが失敗しました。
 
(困っていること)
・エラーを直す方法
・入力規則でリスト形式にするコードの範囲をその時々のデータによって変更するには
どのようにコードを書き直したほうがいいか分からない
 
Sub 名前のリストを作成()
 
Dim a
Dim b
 
Set a = Worksheets("集計")
    a.Columns("J:J").Copy
     
Set b = Worksheets("リスト")
    b.Range("J2").PasteSpecial Paste
    Application.CutCopyMode = False
     
    a.Range("$J$1:$J$338").RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWindow.SmallScroll Down:=-15
 
End Sub

回答
投稿日時: 19/12/24 14:17:20
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的なこと
 
コピー〜ペースト
は、貼り付ける大きさ(セルの個数)と貼付けっれる大きさ(セルの個数)は
同一であること
 
今回のコードでは
列Jを指定してCopyしているから
セルの個数は、1048576個になります。
 
貼り付けられる側じゃ
J2を先頭指定しているから
J2〜J1048577になります。
しかし、J1048577というセルは存在しないからエラーになるのです。
 
 

投稿日時: 19/12/24 14:36:01
投稿者: chokobanana

b.Range("J2").PasteSpecial Paste
   ↓
b.Columns("P:P").PasteSpecial Paste
 
2行目にコピーしたかったですが1行目から余白(JからPに変更)に
変更してみましたが同じエラーが出ます。
 
 

投稿日時: 19/12/24 14:49:10
投稿者: chokobanana

マクロの記録 無修正版です。
 
Sub Macro2()
 
    Sheets("集計").Select
    Columns("J:J").Select
    Selection.Copy
    Sheets("リスト").Select
    Columns("P:P").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveSheet.Range("$P$1:$P$554").RemoveDuplicates Columns:=1, Header:=xlNo
    Columns("C:C").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$P:$P"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End Sub

回答
投稿日時: 19/12/24 15:47:10
投稿者: WinArrow
投稿者のウェブサイトに移動

chokobanana さんの引用:
b.Range("J2").PasteSpecial Paste
   ↓
b.Columns("P:P").PasteSpecial Paste
 
2行目にコピーしたかったですが1行目から余白(JからPに変更)に
変更してみましたが同じエラーが出ます。
 
 

 
コードにて手抜きが見られます。
 
最後の「Paste」引数をキチンと指定しましょう。

投稿日時: 19/12/24 16:50:08
投稿者: chokobanana

修正してみました
エラーはでなくなりました。
 
 b.Range("$P$1:$P$554").RemoveDuplicates Columns:=1, Header:=xlNo
 
をその時々の行数にするに変動させるにはどうやって書いたらいいのでしょうか?
コードの数値を都度修正しなくてもいい方法がありましたら教えてください。
 
その他コードの書き方でおかしい箇所がありましたら教えてください。
 
 
Sub Macro2()
 
Dim a
Dim b
 
 Set a = Worksheets("????")
 Set b = Worksheets("?d?l??")
  
    a.Columns("J:J").Copy
     
    b.Columns("P:P").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
     
    b.Range("$P$1:$P$554").RemoveDuplicates Columns:=1, Header:=xlNo
    Columns("C:C").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=$P:$P"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .IMEMode = xlIMEModeNoControl
        .ShowInput = True
        .ShowError = True
    End With
End Sub

回答
投稿日時: 19/12/24 19:30:57
投稿者: WinArrow
投稿者のウェブサイトに移動

準備作業として「名前定義」を行います。
「数式」タブ⇒「名前の定義」
名前:名前リスト
参照範囲:=OFFSET(Sheet1!$P$1,0,0,COUNTA(リスト!$P:$P),1)
OK
 
コード
@ABは、コード修正
Cは、手操作で入力規則を競定しておけば、マウロでは設定不要のコードです。
Sub Macro2()
   
'@
' Dim a
' Dim b

Dim a As Worksheet, b As Worksheet
 
    Set a = Worksheets("????")
    Set b = Worksheets("?d?l??")
'A
' a.Columns("J:J").Copy
'
' b.Columns("P:P").PasteSpecial xlPasteValues
' Application.CutCopyMode = False

    With a
        With .Range(.Range("J1"), .Cells(.Rows.Count, "J").End(xlUp))
            b.Range("P1").Resize(.Rows.Count, 1).Value = .Value
        End With
    End With
     
'B
' b.Range("$P$1:$P$554").RemoveDuplicates Columns:=1, Header:=xlNo

    With b
        With .Range(.Range("P1"), .Cells(.Rows.Count).End(xlUp))
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    End With
      
'C
    With b.Columns("C:C")
        With .Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=名前リスト"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .IMEMode = xlIMEModeNoControl
            .ShowInput = True
            .ShowError = True
        End With
    End With
End Sub
 
 
 

回答
投稿日時: 19/12/24 22:19:24
投稿者: WinArrow
投稿者のウェブサイトに移動

追記
 
Cのところ
> Columns("C:C").Select
シートの修飾がなかったので
 
勝手ni
With b.Columns("C:C")
としてしまいましたが、
意図しない場合は、修正してくださいね・・・

投稿日時: 19/12/25 09:13:48
投稿者: chokobanana

WinArrowさん
 
シート名リストのP列の名前の重複が削除されないです。
なのでリストに同じ名前がたくさん出てきてしまいました。
 
マクロの記録のコードと見比べたりしてみましたが、自分では解決できませんでした。
教えていただけますでしょうか。
宜しくお願い致します。

回答
投稿日時: 19/12/25 14:22:57
投稿者: WinArrow
投稿者のウェブサイトに移動

同じ名前で「名前定義」されることはないと思いますが、
どのようにして定義したんでしょうか?
 

chokobanana さんの引用:

シート名リストのP列の名前の重複が削除されないです。
なのでリストに同じ名前がたくさん出てきてしまいました。

名前定義をマクロで実行したのでしょうか?
 
名前定義は、1回だけでよいので
マクロで実行する必要はありません。
 

回答
投稿日時: 19/12/25 14:39:09
投稿者: simple

質問者さんへ。
重複の排除をしているのは下記の箇所だけ。

    With b
        With .Range(.Range("P1"), .Cells(.Rows.Count).End(xlUp))
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
    End With
回答者だってケアレスミスはするんだから、
一番の当事者である質問者さんが、もっと気合いを入れて確認しないといけない。
人に頼ることがを当たり前と考えていてはいけないんじゃないかな。
Cellsの中に列指定が漏れています。
 
それと、コメントがあったら、返事くらいするのが礼儀だと思う。
他のWordのスレッドも拝見したが、結構、回答者から厳しい指摘を受けていますね。
ちょっと改善されたほうがよいと思います。

回答
投稿日時: 19/12/25 14:51:43
投稿者: WinArrow
投稿者のウェブサイトに移動

19/12/25 14:22:57
のレスについて・・・・
勘違いしていました。スルーしてください。
 
私の提示したコードに間違いがあったのですね?
simpleさん、フォローありがとうございました。
>cells(.Rows.Count,"P")
列指定が抜けていました。
年のせいにするのではないが、私もよく忘れるんです。

投稿日時: 19/12/25 17:06:27
投稿者: chokobanana

WinArrowさん
 
試行錯誤しましたが自分では原因が分かりませんでした。
ありがとうございます。