Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

250 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77454】Re:カレンダーに青太線

β - 15/10/13(火) 7:16 -


	引用なし

	パスワード

▼桃太郎さん：

おはようございます。

アップされたコードは一部を修正したあとのものでしょうか？
いずれにしても、コードを読んで推測しながら、こうじゃないですかという回答をしてもいいのですが
その推測が間違っているかもしれませんね。

どのような罫線を引きたいのか、言葉で明確に定義されたほうが回答しやすいですね。

・ある矩形の領域がある。そこは、現在、どんなアドレスなのか。
・将来列が増える可能性があるか、行が増える可能性はあるか。
・その矩形の領域の縦方向に、
　矩形の左端と右端（矩形を囲むところ）には罫線必要か不要か、必要ならどんな罫線か
　矩形の内部の縦方向には、どんな罫線（ヘアラインでしょうけど）を引きたいか
・その矩形の領域の横方向に
　矩形の上端と下端（矩形を囲むところ）には罫線必要か不要か、必要ならどんな罫線か
・その矩形の内部の横方向には、その行の、どのセルの値を参照し、
　それがどんな値なら、どんな罫線を（青太線でしょうけど）引きたいか

このように整理できませんか。

・ツリー全体表示


	【77453】カレンダーに青太線

桃太郎 - 15/10/13(火) 1:34 -


	引用なし

	パスワード

こんにちは、よろしくお願いします。

Cell(4.5)に〇月1日のシリアルがあり、横長のカレンダーが置いてあります。
縦軸はメンバーのシフト表が32行目までありましたが、
事情により37行目まで増やしました。

7年ぐらい前にここで土日に青太線で囲むマクロを作っていただきました。
ところが今それを使うとまともに動かないことがわかりました。

原因がエクセルのバージョンのせいか、行を増やしたせいなのか
恥ずかしながらよくわかりません。

コードを見ていただいて修正していただけたら幸いです。

_________________________________________________________

Sub 罫線作成3()
' 罫線作成 Macro
' マクロ記録日 : 2006/3/13　ユーザー名 :

　　Dim rngCurrent As Range
　　Dim kei As Integer
　
　　Set rngCurrent = ActiveSheet.Cells(4, 5)
　
　　Application.ScreenUpdating = False
　
　　With rngCurrent
　　　　With .Resize(29, 31)
　　　　　　.Borders(xlDiagonalDown).LineStyle = xlNone
　　　　　　.Borders(xlDiagonalUp).LineStyle = xlNone
　　　　　　With .Borders(xlEdgeLeft)
　　　　　　　　.Weight = xlHairline
　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　End With
　　　　　　With .Borders(xlEdgeTop)
　　　　　　　　.Weight = xlThin
　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　End With
　　　　　　With .Borders(xlEdgeBottom)
　　　　　　　　.Weight = xlThin
　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　End With
　　　　　　With .Borders(xlEdgeRight)
　　　　　　　　.Weight = xlHairline
　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　End With
　　　　　　With .Borders(xlInsideVertical)
　　　　　　　　.Weight = xlHairline
　　　　　　　　.ColorIndex = xlAutomatic
　　　　　　End With
　　　　End With
　　　　'青太線の出力
　　　　For kei = 0 To 30
　　　　　　With .Offset(, kei).Resize(29)
　　　　　　　　Select Case .Item(37, 1).Value
　　　　　　　　　　Case Is = 7
　　　　　　　　　　　　With .Borders(xlEdgeLeft)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　　　　　　　With .Borders(xlEdgeTop)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　　　　　　　With .Borders(xlEdgeBottom)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　If kei = 30 Then
　　　　　　　With .Borders(xlEdgeRight)
　　　　　　　　.Weight = xlMedium
　　　　　　　　.ColorIndex = 11
　　　　　　　End With
　　　　　　　　　　　　　End If
　　　　　　　
　　　　　 Case Is = 1
　　　　　　　　　　
　　　　　　If kei = 0 Then
　　　　　　　With .Borders(xlEdgeLeft)
　　　　　　　　.Weight = xlMedium
　　　　　　　　.ColorIndex = 11
　　　　　　　End With
　　　　　　End If
　　　　　　　　　　　　With .Borders(xlEdgeTop)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　　　　　　　With .Borders(xlEdgeBottom)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　　　　　　　With .Borders(xlEdgeRight)
　　　　　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　　　　　.ColorIndex = 11
　　　　　　　　　　　　End With
　　　　　　　　End Select
　　　　　　End With
　　　　Next kei
　　End With

　　Set rngCurrent = Nothing
　
　　Application.ScreenUpdating = True

以上です。自分でも数字をいじってみましたが、ますます動かなくなりました。
よろしくお願いします

・ツリー全体表示


	【77452】アドインタブにアドイン側からボタンを追...

名無しのプログラマー - 15/10/12(月) 21:34 -


	引用なし

	パスワード

見ていただきありがとうございます。

今回、アドインを使ったプログラムを作成したいと考えていおり、
処理として、リボン上のアドインタブにボタンやメニューを追加してマクロを登録する(リボンを新規作成はなし)というものを想定しています。(動作環境はExcel2010です)

その中で、ボタンなどを追加するには、CommandBarオブジェクトを使用すればいいという事はわかったのですが、

肝心のCommandBarオブジェクトの、「メニューコマンド」、「ツールバーコマンド」、「ユーザー設定のツールバー」についての違いがわからなくて困っています。

と言うのもいつかのネット記事を見ていても、Excel2003関する記事ばかりで、Excel2010のことが書かれた記事があっても、Excel2010上では一部のメソッドで動作は保証できないと書かれているだけで汎用性がイマイチわからない状態です。

Excel2010上でVBA操作した場合に、各メニューグループでコマンドボタンなど特定のボタンが置けないやレイアウトなど違いがあるのでしょうか?

また、レイアウトに関しても3つ以外の新しいグループの追加や、画像の変更(既存以外)などができるできない等の情報を知っている方がいたらお願いします。

・ツリー全体表示


	【77451】Re:多量の複数セルをコピーし入れ替えし...

β - 15/10/9(金) 9:08 -


	引用なし

	パスワード

▼YUKI さん：

思い付きですが。

Private Function GetRange(adr As String) As Range
　　Dim r As Range
　　Dim w As Variant
　　Dim a As Variant
　　Dim s As String
　　w = Split(adr, ",")
　　
　　For Each a In w
　　　　If Len(s) = 0 Then
　　　　　　s = a
　　　　Else
　　　　　　If Len(s) + Len(a) > 254 Then
　　　　　　　　AddRange r, Range(s)
　　　　　　　　s = a
　　　　　　Else
　　　　　　　　s = s & "," & a
　　　　　　End If
　　　　End If
　　Next
　　
　　AddRange r, Range(s)
　　Set GetRange = r
　　
End Function

Private Sub AddRange(r As Range, c As Range)
　　If r Is Nothing Then
　　　　Set r = c
　　Else
　　　　Set r = Union(r, c)
　　End If
End Sub

こんなサブプロシジャを準備しておいて、使う際には、アドレス文字列を
何の心配もなく（？）好きなだけ長いもので指定。
サブプロシジャ内で、できるだけ少ないUnion回数でUnionして返すというやりかたも
あるかもしれませんね。

Sub Test()
　　Dim r As Range
　　Dim s As String
　　
　　s = "A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84," & _
　　　　"A88:OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167," & _
　　　　"A175:OH175,A184:OH184,A211:OH211,A205:OH205"

　　Set r = GetRange(s)
　　
　　MsgBox r.Address
　　r.Select
　　
End Sub

MsgBoxでは長すぎる文字列の表示がし切れませんので、Selectで結果を確認してください。

・ツリー全体表示


	【77450】Re:多量の複数セルをコピーし入れ替えし...

ichinose - 15/10/9(金) 7:05 -


	引用なし

	パスワード

▼カリーニンさん：
>試してませんが、セルに名前を定義して、その名前を使う、というのはどうでしょう？
ありがとうございます。

新発見でした。これだとかなり、大きいセル範囲が取得できますね！！

が、これでも限界はありそうです。

Sub test1()
　　Dim rng As Range
　　Dim add As String
　　Dim st As Double
　　Dim idx As Long, jdx As Long
　　st = Now()
　　add = "=" & Cells(1, 1).Address(False, False)
　　For idx = 1 To 44 Step 2
　　　 For jdx = 3 To 20 Step 2
　　　　　add = add & "," & Cells(idx, jdx).Address(False, False)
　　　　　Next
　　　 Next
　　Debug.Print Len(add)
　　Names.add Name:="aaaa", RefersTo:=add
　　Range("aaaa").Select
　　MsgBox Format(Now() - st, "hh:mm:ss")
End Sub

>For idx = 1 To 44 Step 2

Excel2010で　idxが　44だと正常に処理できますが、45では、Names.addの箇所でエラーに成りました。

これを使えば　長いセル範囲（セルアドレス）を操作したい時に　Unionの回数は減らせそうです

・ツリー全体表示


	【77449】Re:あるセルに手入力したら、その下のセ...

kouka - 15/10/8(木) 18:59 -


	引用なし

	パスワード

こんばんは、koukaです。
βさん、Jakaさん質問に付き合ってくれてありがとうございました!

あれから、どうもしっくりこないので、VBA参考書をみていたら、
『Target.Address』でセルをしてしちゃえばいいのでは、
と、自問自答が起こり、下記のようなコードに変えてみました。

Private Sub Worksheet_Change(ByVal Target As Range)

　　If Target.Address = "$A$1" Then
　　　　Range("A2").ClearContents
　　End If

End Sub

同じ名前を入れてもクリアさせるのが前提ですので、
セルを指定してあげればいいのですよね!?

変に難しく考え過ぎていたようです。。。
いろいろ教えていただきありがとうございました!

・ツリー全体表示


	【77448】Re:多量の複数セルをコピーし入れ替えし...

カリーニン - 15/10/8(木) 17:53 -


	引用なし

	パスワード

他のブックでしたか。見落としてました。
他のブックの名前の定義のセルアドレスの取得方法です。

Dim wbA As Workbook
Dim nm As Name
　Set wbA = Workbooks.Open("C:\Users\USER\Desktop\1746.xlsm")
　Set nm = wbA.Names("aiu")
　MsgBox Range(nm).Address
　Set wbA = Nothing

・ツリー全体表示


	【77447】Re:多量の複数セルをコピーし入れ替えし...

YUKI - 15/10/8(木) 13:23 -


	引用なし

	パスワード

皆様返答ありがとうございます！

ウッシ様のコードで動くようになりました。ありがとうございます。
Unionは知りませんでした。。。まだまだ勉強不足です。

セルの名前の意義は、
コピー元のブックやシートが異なったりしていても使えるんでしょうか？
名前の定義はグラフの自動更新程度でしか使った事がなかったです。
色々試して勉強します。

ありがとうございました

・ツリー全体表示


	【77446】Re:多量の複数セルをコピーし入れ替えし...

カリーニン - 15/10/8(木) 10:02 -


	引用なし

	パスワード

試してませんが、セルに名前を定義して、その名前を使う、というのはどうでしょう？

アイデアは私のオリジナルではなく、最近、他サイトで行継続文字についての質問が
あり、そこで提示されていたアイデアです。

・ツリー全体表示


	【77445】Re:多量の複数セルをコピーし入れ替えし...

ichinose - 15/10/8(木) 7:03 -


	引用なし

	パスワード

>Range("A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84,
>A88:OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167,
>A175:OH175,A184:OH184,A211:OH211,A205:OH205").Copy
>　　ThisWorkbook.Activate
>　　Sheets("OTHER").Select
>　　Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Sub test()
　　Dim add As String
　　add = "A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84,A88: OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167,A175:OH175,A184:OH184, A211:OH211,A205:OH205"
　　MsgBox Len(add)
　　Range(add).Copy
End Sub

セルアドレス文字列長が255を超えると、
range("xxx")は、提示されたようなエラーに成ります。

この255を意識したコードにしなければなりません。

かと言って、単純に255で切るって訳には行きませんしね！！

既に提示されているようにUnionメソッドは、有効方法ですが、
これとて、セルアドレスが多くなると、処理速度が、極端に落ちますから、
注意が必要です。

www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=54;id=FAQ

↑目安箱より、「トロイぞUnion」

・ツリー全体表示


	【77444】Re:多量の複数セルをコピーし入れ替えし...

ウッシ - 15/10/7(水) 15:12 -


	引用なし

	パスワード

こんにちは

Sub test1()
　　Intersect(Range("A:OH"), _
　　　　Union(Range("A1:A4,A11,A13:A14,A18,A25,A31,A33,A35,A61"), _
　　　　　　Range("A64:A65,A67,A71:A72,A84,A88,A90,A104,A107:A108,A110"), _
　　　　　　Range("A114,A132:A133,A151,A157,A160,A167,A175,A184,A205,A211")).EntireRow).Copy

　　ThisWorkbook.Sheets("OTHER").Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

End Sub

とか、色々出来ますよ。

▼YUKI さん：
>再度行き詰ってしまったのでお願いします。
>
>別ブックから該当の複数セルを選択し、行列を入れ替えて値貼付を行いたいです。
>コピーの対象はA～OH列の複数行です。
>
>少量の時はうまく行っていたのですが、選択数が増えたら
>'Range'メソッドは失敗しました：'_global'オブジェクト
>とのエラーが起きてしまいました。
>出来れば行修正の間違いの少ない記述が知りたいのですが
>お教え願えませんでしょうか
>
>
>Range("A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84,
>A88:OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167,
>A175:OH175,A184:OH184,A211:OH211,A205:OH205").Copy
>　　ThisWorkbook.Activate
>　　Sheets("OTHER").Select
>　　Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

・ツリー全体表示


	【77443】多量の複数セルをコピーし入れ替えして貼...

YUKI - 15/10/7(水) 14:18 -


	引用なし

	パスワード

再度行き詰ってしまったのでお願いします。

別ブックから該当の複数セルを選択し、行列を入れ替えて値貼付を行いたいです。
コピーの対象はA～OH列の複数行です。

少量の時はうまく行っていたのですが、選択数が増えたら
'Range'メソッドは失敗しました：'_global'オブジェクト
とのエラーが起きてしまいました。
出来れば行修正の間違いの少ない記述が知りたいのですが
お教え願えませんでしょうか

Range("A1:OH4,A11:OH11,A13:OH14,A18:OH18,A25:OH25,A31:OH31,A33:OH33,A35:OH35,A61:OH61,A64:OH65,A67:OH67,A71:OH72,A84:OH84,
A88:OH88,A90:OH90,A104:OH104,A107:OH108,A110:OH110,A114:OH114,A132:OH133,A151:OH151,A157:OH157,A160:OH160,A167:OH167,
A175:OH175,A184:OH184,A211:OH211,A205:OH205").Copy
　　ThisWorkbook.Activate
　　Sheets("OTHER").Select
　　Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True

・ツリー全体表示


	【77442】Re:VBAで別ブックから反映について

馬 - 15/10/6(火) 12:36 -


	引用なし

	パスワード

ありがとうございます！
完璧でした！

・ツリー全体表示


	【77441】Re:VBAで別ブックから反映について

β - 15/10/6(火) 6:41 -


	引用なし

	パスワード

▼馬さん：

それでは以下で。

Sub Test2()
　　Dim shA As Worksheet
　　Dim shB As Worksheet
　　Dim dic As Object
　　Dim c As Range
　　
　　Set shA = Workbooks("ブックA.xlsx").Sheets("Sheet1")　　'★
　　Set shB = Workbooks("ブックB.xlsx").Sheets("Sheet1")　　'★
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For Each c In shA.Range("A2", shA.Range("A" & Rows.Count).End(xlUp))
　　　　dic(c.Value) = c.EntireRow.Range("C1").Value
　　Next
　　
　　For Each c In shB.Range("A2", shB.Range("A" & Rows.Count).End(xlUp))
　　　　If dic.exists(c.Value) Then c.EntireRow.Range("F1").Value = dic(c.Value)
　　Next
　　
End Sub

・ツリー全体表示


	【77440】Re:VBAで別ブックから反映について

馬 - 15/10/5(月) 14:07 -


	引用なし

	パスワード

β様

お返事遅くなり申し訳ございません。

ご回答ありがとうございます。

上記コードでは、ブックＡに商品コードがなくて、
ブックＢにある場合、ブックＢの備考が消えてしまいます。
（VLOOKUPでエラーを空白にする処理そされてるからだと
思いますが・・・）

そうではなく、ブックＡに商品コードがある場合、ブックＢの備考に
貼り付け、
それ以外（ブックＢにはあるが、ブックＡにない場合）の備考は
何も変更したくないのですが、
それは可能でしょうか？？

・ツリー全体表示


	【77439】Re:あるセルに手入力したら、その下のセ...

β - 15/10/2(金) 17:28 -


	引用なし

	パスワード

▼kouka さん：

同姓同名というのは　変数　にお名前のことです。
それはさておき、要件を誤解しているかもしれませんが

Private Sub Worksheet_Change(ByVal Target As Range)
　　'A1変更があった時のみ処理
　　If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
　　'今回はマクロ内での変更はA2なのでなくてもいいけどたしなみとして
　　Application.EnableEvents = False　　'イベント発生抑止
　　Range("A2").ClearContents
　　Application.EnableEvents = True　　 'イベント発生再開
End Sub

・ツリー全体表示


	【77438】Re:あるセルに手入力したら、その下のセ...

Jaka - 15/10/2(金) 17:07 -


	引用なし

	パスワード

>Range("A2").ClearContents
これでセルの内容を変更しているので、また
Worksheet_Change　イベントが発生します。
で、またクリアすると、Worksheet_Change　イベントが発生します。
で、なんかしらが溜まり積もって、スタックオーバー・・。
こんな感じに書き込む前にイベントを中止しましょう。

Application.EnableEvents = False 'イベント中止
Range("A2").ClearContents
Application.EnableEvents = True　'書き終わったら戻す。

・ツリー全体表示


	【77437】Re:あるセルに手入力したら、その下のセ...

kouka - 15/10/2(金) 16:43 -


	引用なし

	パスワード

βさん、ヒントありがとうございました!
・・・ですが、また壁に当たってしまったので、質問させてください。

worksheetに下記のコードを作ったのですが・・・

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim 商品名 As String

　　If Range("$A$1") <> 商品名 Then
　　　　Range("A2").ClearContents
　　　　商品名 = Range("$A$1")
　　End If

End Sub

『実行時エラー'28':スタック領域が不足しています。』と出てきて、
Excel自体が再起動してしまいます。

ちなみに前回書き忘れましたが、Win7のExcel2010です。

それと同姓同名の場合でも同じ処理をしたいので、
それは考えなくていいです。

こんな短いコードでこんなにうまくいかないのは久しぶりで、
どうしたらいいのか、わけわからん状態ですが、
すみませんが、教えてください。。。
よろしくお願いします。

・ツリー全体表示


	【77436】Re:繰り返し　コピーペースト

YUKI - 15/10/2(金) 16:10 -


	引用なし

	パスワード

▼β さま

完璧です！！思い通りの結果になりました！
容量も激減し速度も速い・・さすがです。

教えていただいたコードを少しづつ理解し、
いつか解答できる立場になれたらなぁと思います。
本当にありがとうございました！！

・ツリー全体表示


	【77435】Re:繰り返し　コピーペースト

β - 15/10/2(金) 15:07 -


	引用なし

	パスワード

▼YUKI さん：

要件の誤解あれば指摘ください。

Sub Test2()
　　Dim myA As Range
　　Dim myC As Range
　　Dim r As Range
　　Dim col As Range
　　Dim pos As Range
　
　　Application.ScreenUpdating = False
　　
　　Set myA = Range("AG1:BL180")　　'列数が増減あればここを変更
　　Set r = Range("E4:S180")　　　　'関数で生成される領域
　　
　　For Each myC In myA.Columns　　'mya から　列単位で変数 myc に取出し
　　　　Range("A1").Resize(myA.Rows.Count).Value = myC.Value
　　　　myC.EntireColumn.ClearContents
　　　　Set pos = Nothing
　　　　For Each col In r.Columns
　　　　　　If pos Is Nothing Then
　　　　　　　　Set pos = myC.Cells(1)
　　　　　　End If
　　　　　　pos.Resize(r.Rows.Count).Value = col.Value
　　　　　　Set pos = pos.Offset(r.Rows.Count)
　　　　Next
　　　　myC.Resize(Cells(Rows.Count, myC.Column).End(xlUp).Row).Sort Key1:=myC.Cells(1), Header:=xlYes
　　Next
　　
End Sub

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

250 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free