Excel VBA質問箱 IV

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

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


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

249 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77459】Re:セルの内容をテキスト化するマクロの...

ウッシ - 15/10/13(火) 10:52 -


	引用なし

	パスワード

こんにちは

・9列目に格納されてると先頭に全角スペースと「→」を追加して出力。
・9列目の内容が日付だった場合は「月/日(曜)」の書式で出力。

9列目の条件が2つですか？

・ツリー全体表示


	【77458】セルの内容をテキスト化するマクロの機能...

SHO - 15/10/13(火) 10:37 -


	引用なし

	パスワード

はじめまして。
ネットで展開されているソースを改変して使うのが精一杯の
VBA初心者で皆様のお力をお借りしたく投稿させていただきます。

起動させるとセルの内容をテキスト化するマクロなのですが、
下記のループで以下の機能を追加していただきたいのです。
・8列目に格納されてると先頭に全角スペースと「・」を追加して出力。
・9列目に格納されてると先頭に全角スペースと「→」を追加して出力。
・9列目の内容が日付だった場合は「月/日(曜)」の書式で出力。

　　Do Until GYO > GYOMAX
　　　　strREC = Cells(GYO, 7).Value & Cells(GYO, 8).Value & Cells(GYO, 9).Value & Cells(GYO, 10).Value　　　　　　　　　　　
　　　　lngREC = lngREC + 1
　　　　xlAPP.StatusBar = "出力中です．．．．(" & lngREC & "レコード目)"
　　　　' レコードを出力
　　　　Print #intFF, strREC　　　　　　　　　　　　　
　　　　GYO = GYO + 1
　　Loop

質問に不足ありましたらご指摘ください。
よろしくお願いします。

・ツリー全体表示


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

β - 15/10/13(火) 10:22 -


	引用なし

	パスワード

▼桃太郎さん：

申し上げたように、要件を具体的に説明いただければ、適切な回答も可能かと思いますが
以下は、想像をたくましくしたコード案です。
領域や、罫線要件に誤解があるかもしれませんが。

Sub test()

　　Dim rngCurrent As Range
　　Dim col As Range
　　Dim chk As Variant
　　
　　Set rngCurrent = Range("D4:AH32")
　　
　　Application.ScreenUpdating = False

　　'領域の罫線を処理前に削除
　　rngCurrent.Borders.LineStyle = xlNone
　　'左端、右端含めて、縦に HairLine
　　With rngCurrent.Offset(, -1).Resize(, rngCurrent.Columns.Count + 2).Borders(xlInsideVertical)
　　　　.LineStyle = xlContinuous
　　　　.ColorIndex = xlAutomatic
　　　　.TintAndShade = 0
　　　　.Weight = xlHairline
　　End With
　　'領域上端、下端に細実線
　　With rngCurrent.Borders(xlEdgeTop)
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　End With
　　With rngCurrent.Borders(xlEdgeBottom)
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　End With
　　'土日枠
　　For Each col In rngCurrent.Columns
　　　　chk = Cells(40, col.Column).Value
　　　　Select Case chk
　　　　　　Case 1, 7
　　　　　　　　'列上端、下端に青太線
　　　　　　　　With col.Borders(xlEdgeTop)
　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　.ColorIndex = 11
　　　　　　　　End With
　　　　　　　　With col.Borders(xlEdgeBottom)
　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　.ColorIndex = 11
　　　　　　　　End With
　　　　　　　　'左あるいは右に青太線
　　　　　　　　With col.Borders(IIf(chk = 1, xlEdgeRight, xlEdgeLeft))
　　　　　　　　　　.Weight = xlMedium
　　　　　　　　　　.ColorIndex = 11
　　　　　　　　End With
　　　　End Select
　　Next
　　
　　Set rngCurrent = Nothing

　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【77456】Re:アドインタブにアドイン側からボタン...

独覚 - 15/10/13(火) 9:33 -


	引用なし

	パスワード

ここのサイトの基本方針から引用です。

>マルチポストについて
>別のサイト（掲示板）にまったく同じ目的の投稿をすることを、一般に「マルチポスト」といいます。
>当質問箱では、マルチポストは原則認めています。
>つまり、ほかのサイトで質問したことをこのサイトで質問してもかまわないということです。

>しかし、もしマルチポストをするのなら、可能な限り「○○にも同じ質問を出しました」ということを宣言してください。
>そして、仮に他のサイトで解決したのなら、ここにも必ずその顛末を書いてください。
>質問しっぱなし、というのはモラルに反します。「解決したからいいや」というのではありません。

>また、マルチポストを明示的に禁止しているサイトとのマルチポストをしてはいけません。

ということですのでマルチポスト先の報告をお願いいたします。

・ツリー全体表示


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

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


	引用なし

	パスワード

▼桃太郎さん：

想像ですけど、レイアウトと罫線要件は以下のようなことですか？

・対象の領域は E4:AI32
・領域の上端、下端には、細線の黒
・領域の縦方向には左端、右端含めてヘアライン
・その上で各列の４０行目の値（曜日が数字ではいっているんでしょうかね）を参照し
　7なら左、上端、下端が青太線、1なら右、上端、下端が青太線。
　結果的に 7,1 が連続していれば（土、日　ですかね）週末の縦２列が青太線で囲まれる。

こういうことでしょうかね？

この場合、将来、また行が増えるとすれば、40行目の判定場所もデータ行になるかもしれませんね。
行が増えても問題のない場所、矩形領域の上のほうに、それをもっていったほうがいいと思いますね。

・ツリー全体表示


	【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でエラーを空白にする処理そされてるからだと
思いますが・・・）

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

・ツリー全体表示


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

249 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free