[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【マクロ】シート間の転記マクロ：オブジェクト変数または With ブロック変数が設定されていません。』（トイレの女神）
こんにちは(._.)
シート間の転記マクロを作ったみたのですが
エラーになってしまったので
ご相談させて下さい！
(色んなとこから引っ張ってつないだり
マクロの記録を使って書き換えてみただけですが、、、。)
他にもシート間転記でうまくいっていないという
質問があったのですが
私のとはまた違ったものと感じたので
今回別スレ立てております。。。
もし既出の質問でしたら
ご容赦下さい(T_T)
下記にまとめてみましたので
解決策等ご教授いただけますと幸いです。
よろしくおねがいします！
(変数の型の指定って難しいですね、、、。)
★やりたいこと
シート1の3行目の見出し(項目名)を検索して1つ下のセルに入っているデータを5つコピーして
シート2の4行目の見出し(項目名)を検索して1つ下のセルに貼り付けたい
★書いたコード
'変数でシートを指定
Dim mori As Worksheet
Set sutera = Worksheets("sheet1")
Dim kaze As Worksheet
Set pafu = Worksheets("sheet2")
'シート1からそれぞれ見出しの一つ下に入っているデータを取得
With mori
Set mituketa1 = .Range("3:3").Find(What:="割当", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa2 = .Range("3:3").Find(What:="いつ", LookAt:=xlPart).Offset(1, 0).Select '書式はmmmm/yy/dd
Set mituketa3 = .Range("3:3").Find(What:="なぜ", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa4 = .Range("3:3").Find(What:="状況", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa5 = .Range("3:3").Find(What:="必要なもの", LookAt:=xlPart).Offset(1, 0).Select
End With
'シート2のそれぞれ見出しの一つ下にデータを貼り付ける場所を作る
With kaze
Set mituketa6 = .Range("4:4").Find(What:="割当", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa7 = .Range("4:4").Find(What:="いつ", LookAt:=xlPart).Offset(1, 0).Select '書式はmmmm/yy/dd
Set mituketa8 = .Range("4:4").Find(What:="なぜ", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa9 = .Range("4:4").Find(What:="状況", LookAt:=xlPart).Offset(1, 0).Select
Set mituketa10 = .Range("4:4").Find(What:="必要なもの", LookAt:=xlPart).Offset(1, 0).Select
End With
'変数がたくさんあるからまとめたい！！
Set beaf = Range("mituketa1 , mituketa2, mituketa3, mituketa4, mituketa5")
Set fish = Range("mituketa6 , mituketa7, mituketa8 ,mituketa9, mituketa10 ")
'コピーして貼り付け
beaf.Copy fish.PasteSpecial Paste:=xlPasteValues
End Sub
★エラーになった箇所
Set mituketa1 = .Range("3:3").Find(What:="割当", LookAt:=xlPart).Offset(1, 0).Select
★出てきたエラー
実行時エラー'91'
オブジェクト変数またはWithブロック変数が設定されていません
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
'変数でシートを指定
Dim mori As Worksheet
Set mori = Worksheets("sheet1")
Dim kaze As Worksheet
Set kaze = Worksheets("sheet2")
の間違いです()
（トイレの女神） 2018/09/11(火) 14:12
まずは [[20180906130635]] 『【マクロ】データの重複の削除を行う』（トイレの女神） と同じくSelectを外した上でうまくいくか確認してくれ。 （ねむねむ） 2018/09/11(火) 14:18
いつもありがとうございます(*^^*)
まーた同じ間違いを、、、、
これで解決！と思ったのですが
同じようにオブジェクト変数またはWithブロック変数が設定されていませんの
エラーが出てきてしまいます...
（トイレの女神） 2018/09/11(火) 14:34
mituketa1～mituketa10はDim句でどのように定義しているのだろうか？ （ねむねむ） 2018/09/11(火) 14:37
たぶん、前トピックから微妙に勘違いされたままなのでは？
気になっているのはココ
＞なるほど、RangeとSelectでコードの意味が重複しているため エラーになっていたんですね、、、
もともと記述ルールとして 「オブジェクト」.「メソッド（命令）」という書き方が基本なのに、
前ピックのエラーになったコードでは
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select.RemoveDuplicates Columns:=(3), Header:=xlYes
つまり、コードの意味が重なってたというか「オブジェクト」.「メソッド（命令）」.「メソッド（命令）」とメソッドの後ろに「メソッドが重なっていた」のがおかしいです。
それでも、Excel君が頑張って実行しようとした結果、
ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select の結果であるTrueと解釈して
True.RemoveDuplicates Columns:=(3), Header:=xlYes
ってなってるから変ですよ。っていうのがねむねむさんの指摘だとおもわれます。
なので、今回もメソッドが重なっているので、そこを修正すべきです。
なお、Findメソッドを使用するのであれば、見つからなかった場合も考慮しておいたほうがいいですよ。
（※絶対に見つかるようにシートを構成しているなら別）
（もこな２） 2018/09/11(火) 14:57
Sub test()
Dim mori As Worksheet
Dim kaze As Worksheet
Dim vw As Variant
Dim F As Variant
Dim i As Long
Set mori = Worksheets("sheet1")
Set kaze = Worksheets("sheet2")
F = Array("割当", "いつ", "なぜ", "状況", "必要なもの")
For i = 0 To UBound(F)
vw = mori.Range("C:C").Find(What:=F(i), LookAt:=xlPart).Offset(1, 0)
kaze.Range("D:D").Find(What:=F(i), LookAt:=xlPart).Offset(1, 0) = vw
Next i
End Sub
（???） 2018/09/11(火) 15:17
Sub 名無しのマクロ()
Dim MyArr As Variant
Dim src(4) As String
Dim dst(4) As String
Dim i As Long
'変数でシートを指定(宣言した変数名とセットしている変数名が合ってないのを修正)
Dim mori As Worksheet: Set mori = Worksheets("sheet1")
Dim kaze As Worksheet: Set kaze = Worksheets("sheet2")
MyArr = Array("割当", "いつ", "なぜ", "状況", "必要なもの")
'シート1にあるコピー元のセル番地を取得
For i = 0 To 4
src(i) = mori.Range("3:3").Find(What:=MyArr(i), LookAt:=xlPart).Offset(1, 0).Address
Next i
'シート2にある貼付先のセル番地を取得
For i = 0 To 4
dst(i) = kaze.Range("4:4").Find(What:=MyArr(i), LookAt:=xlPart).Offset(1, 0).Address
End With
'ループ処理でValueプロパティを参照して､値コピーの実行
For i = 0 To 4
kaze.Range(dst(i)).Value = mori.Range(src(i)).Value
Next i
End Sub
（もこな２） 2018/09/11(火) 15:23
Sub 名無しのマクロ弐()
Dim buf As Variant
For Each buf In Array("割当", "いつ", "なぜ", "状況", "必要なもの")
Worksheets("sheet2").Range("4:4").Find(What:=buf, LookAt:=xlPart).Offset(1, 0).Value = _
Worksheets("sheet1").Range("3:3").Find(What:=buf, LookAt:=xlPart).Offset(1, 0).Value
Next buf
End Sub
（もこな２） 2018/09/11(火) 15:32
本来であればなにか指定してあげたほうがいいとは思うのですが
イレギュラーでいろいろなものが入る可能性を考慮して
何も指定せずバリアント型で入るようにしています！
※もしかしてそれがいけない...？
型を指定してあげたのですが
それでもエラーは消えませんでした。。。
(念の為文字列：stringもvariantも両方指定してみました...)
もこな2さん
こんにちはm(_ _)m
ご丁寧にどうもありがとうございます！
メゾット(命令)を重ねたら混乱してしまうということ、
なんとなくわかったような気がします。。。
今回でいうとRangeとSelectのところでしょうか？
完全な凡ミスで書いていました :-(
＞なお、Findメソッドを使用するのであれば、見つからなかった場合も考慮しておいたほうがいいですよ。
＞（※絶対に見つかるようにシートを構成しているなら別）
上記アドバイスありがとうございます(*^^*)
今回は絶対見つかるようにシート構成しています！！
でも On Error Resume Nextを追加しておくほうが無難なのかも...
要検討ですね。。。
お返事を書いている間に
？？？さんからお返事が届いてしまったので
作っていただいたマクロは
このあと確認してみます！！
???さん
こんにちは(^_^)
いただいたコードだと列で検索してしまうので
行で使えるように直したところ動きました！！
大変助かりました！ありがとうございます(*^^*)
わがまま言って申し訳ないのですが
オートフィルタを使ってる場合も
転記できるようにしたくて、、、
可視セルのみに適用することってできますか、、、？
下記サイトを見つけて
vw = mori.Range("3:3").Find(What:=F(i), LookAt:=xlPart).Offset(1, 0).EntireRow.Hidden = False
kaze.Range("4:4").Find(What:=F(i), LookAt:=xlPart).Offset(1, 0).EntireRow.Hidden = False = vw
ってしてみたのですが何の解決にもなりませんでした...
(まあ無理くりつっこめばそうなりますよね)
https://oshiete.goo.ne.jp/qa/4256065.html
先日も別スレ[[20180906151104]]で可視セル云々言ってましたが
このブックとは異なるブックで全く異なる作業をしているため
上記スレ解決策では対応できませんでした()
（トイレの女神） 2018/09/11(火) 16:23
＞???さんのヒントをもとに、再考。
＞絶対にFindメソッドが失敗しないなら、これでいいような・・・
上記、どちらも???さんと同じ動きでした！
個人的には2つ目のマクロのほうが
見やすいので好きです(^O^)
（トイレの女神） 2018/09/11(火) 16:34
代入先が非表示なら、代入しても隠れて見えないだけで問題なので、非表示になるのは、代入元の方でしょうかね？ もこな2さんのコードを逆輸入してみます。
Sub test2()
Dim buf As Variant
Dim R As Range
For Each buf In Array("割当", "いつ", "なぜ", "状況", "必要なもの")
Set R = Worksheets("sheet1").Range("3:3").Find(What:=buf, LookAt:=xlPart).Offset(1, 0)
If R.EntireColumn.Hidden = False Then
Worksheets("sheet2").Range("4:4").Find(What:=buf, LookAt:=xlPart).Offset(1, 0).Value = R.Value
End If
Next buf
End Sub
（???） 2018/09/11(火) 16:54
どちらのシートにも
オートフィルタを行にかけているので
非表示になるのは行ですね((+_+))
うまくいかなかったので
ちょっと改造してみましたが
これもうまくいかず、、、
ColumnをRowに変えても試したのですが
まあ違う動きをしますよね()
Sub test2()
Dim buf As Variant
Dim R As Range
Dim Y As Range
For Each buf In Array("割当", "いつ", "なぜ", "状況", "必要なもの")
Set R = Worksheets("sheet1").Range("3:3").Find(What:=buf, LookAt:=xlPart).Offset(1, 0)
If R.EntireColumn.Hidden = False Then
Set Y = Worksheets("sheet2").Range("4:4").Find(What:=buf, LookAt:=xlPart).Offset(1, 0)
If Y.EntireColumn.Hidden = False Then
Y.Value = R.Value
End If
Next buf
End Sub
（トイレの女神） 2018/09/11(火) 17:16
変なこと言っているかもしれません、
ごめんなさい、、、()
（トイレの女神） 2018/09/11(火) 17:20
Sub test3()
Dim buf As Variant
If Worksheets("sheet1").Rows(4).Hidden = False Then
For Each buf In Array("割当", "いつ", "なぜ", "状況", "必要なもの")
Worksheets("sheet2").Range("4:4").Find(What:=buf, LookAt:=xlPart).Offset(1, 0).Value = _
Worksheets("sheet1").Range("3:3").Find(What:=buf, LookAt:=xlPart).Offset(1, 0).Value
Next buf
End If
End Sub
しかしこれだと、いったい何をしたいコードなのかさっぱり判りません。非表示だったら違う行をコピーしたかったりするのでは？ それに、行が可変だとして、列は固定ならば、Findなぞしなくても、コピー先は決まっていませんか？
（???） 2018/09/11(火) 17:31
この状態のときに、
"sheet1"のオートフィルタが設定されている範囲の”1行下”に"sheet2"で抽出されているデータの各項目列に対応するものをコピペしたい。
もし↑だとFindメソッドを使うアプローチ自体が方向違いな気がします。
（やるべきなのは、オートフィルタが設定されている範囲をしらべるとか、抽出件数を調べるとかになりそうな）
（もこな２） 2018/09/11(火) 17:49
＞＞（※絶対に見つかるようにシートを構成しているなら別）
＞上記アドバイスありがとうございます(*^^*)
＞今回は絶対見つかるようにシート構成しています！！
＞でも On Error Resume Nextを追加しておくほうが無難なのかも...
＞要検討ですね。。。
On Errorでも間違いじゃないでしょうけど
Sub test()
Dim mituketa1 As Range
Set mituketa1 = ActiveSheet.Range("3:3").Find(What:="割当", LookAt:=xlPart).Offset(1, 0)
If mituketa1 Is Nothing Then
MsgBox "Findメソッドが失敗しました"
Else
Set mituketa1 = mituketa1.Offset(1)
End If
End Sub
みたいに、Findメソッドは見つからない場合Nothingを返してくるので、それを使って判定する方法もあります。
（もこな２） 2018/09/11(火) 18:00
>★エラーになった箇所
>Set mituketa1 = .Range("3:3").Find(What:="割当", LookAt:=xlPart).Offset(1, 0).Select
>★出てきたエラー
>実行時エラー'91'
>オブジェクト変数またはWithブロック変数が設定されていません
話が別の方向に行ってるようですけど(目的を果たす為に必要な事っぽいので、それ自体は良いんですけど)、
質問の主旨である上記の件は、有効な回答が出てないみたいですけど、もう良いんですか？
因みに（もこな２） 2018/09/11(火) 14:57 の >ActiveSheet.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select の結果であるTrueと解釈して >True.RemoveDuplicates Columns:=(3), Header:=xlYes >ってなってるから変ですよ。っていうのがねむねむさんの指摘だとおもわれます。 >なので、今回もメソッドが重なっているので、そこを修正すべきです。 と言う回答は間違ってます。
まずFINDメソッドで上記のエラーが出るのは、検索値が見つからないのが原因です。 検索値が見つからない為、mituketa1 の中身が空なのでRangeアドレス情報を持っていない状態で、 OFFSETしてるので、オブジェクトが無いのに範囲移動は出来ないと叱られています。 条件の文字などが間違っていないか確認してください。
因みに、ちゃんと検索値が見つかった場合にSelectを付けてると、 実行時エラー13 型が一致しません のエラーが出ます。 これはSETでオブジェクトをメモリ上に格納して操作してるので、 物理的にSelect(選択)すると言う行為が出来ない為です。
（sy） 2018/09/11(火) 22:25
>これはSETでオブジェクトをメモリ上に格納して操作してるので、 >物理的にSelect(選択)すると言う行為が出来ない為です。
ちょっと言葉が変でした。 以下に訂正。
これはSETでオブジェクトをメモリに格納するタイミングなので、 同時に物理的にSelect(選択)すると言う行為が出来ない為です。
（sy） 2018/09/11(火) 22:39
イミディエイトウィンドウで
?range("A1").select
と打つとTrueが返る。
多分選択の可否が返るのだろう。
（ねむねむ） 2018/09/12(水) 10:24
で、Setでオブジェクトの代入を行おうとしているのに論理値を代入しようとして型が一致していないとメッセージを出しているのだろう。 （ねむねむ） 2018/09/12(水) 10:26
おっとこれじゃあすでに書いたことの繰り返しでしかないな。 代入時の処理としてはまず、=の右辺を解決し、その結果を=の左辺に代入する。 なので今回の場合で言えばセルの選択を行いその可否を代入しようとすることになる。
（ねむねむ） 2018/09/12(水) 10:54
試しに
Sub a()
Dim aa As Range
Set aa = Range("B1").Select
End Sub
を実行するとエラーにはなるがB1セルの選択は行われる。
（ねむねむ） 2018/09/12(水) 10:56
みなさんお返事ありがとうございます!
Syさんの説明が私の中で一番しっくりくる
丁寧な説明でした！ありがとうございました(*^^*)
一旦検索文字を簡単な漢数字にしたら
この部分は解決できました！
後ろに項目の名前の後ろに.が入っていたみたいです()
そこが通ったら今度は下記コードがエラーになりました。
★因数の数が一致していません、または不正なプロパティを指定しています
Set beaf = Range("mituketa1 , mituketa2, mituketa3, mituketa4, mituketa5")
Set fish = Range("mituketa6 , mituketa7, mituketa8 ,mituketa9, mituketa10 ")
→.Rangeに変更したところ、参照が不正または不完全ですとエラーが、、、
これってmituketaでRange使っているから命令が2重になっていて
エラーになっているということなのでしょうか。
でも今までのものをまとめるとOffsetで指定しても可視セルのみにならないので
このコード自体はもう使い物にならないですかね(T_T)
＞"sheet1"の3行目が項目行でオートフィルタが設定されており、かつ、抽出がかかっています
＞"sheet2"の4行目が項目行でオートフィルタで抽出されており、かつ、抽出がかかっています
＞この状態のときに、
＞"sheet1"のオートフィルタが設定されている範囲の”1行下”に"sheet2"で抽出されているデータの各項目列に対応するものをコピペしたい。
作業手順としては sheet2→1にコピー
sheet2の4行目が項目行で抽出がかかっていて項目行のひとつ下のセル(データの中では一番上にきているもの)を
sheet1に貼り付ける(sheet1の項目行は3行目で同じく抽出がかかっています。項目行のひとつ下のセルに貼り付ける)
どちらのシートもオートフィルタがかかっているため
セルの直接指定ではない方法を模索しています。
もしかしらたbeafとfishが逆かも、、、？
ちょっと私のあたまではキャパオーバーで
うまく考えられないですが
ここに書いた作業手順に則るようになればいいかなと、、、、
自分でももう少し模索してみます...
（トイレの女神） 2018/09/12(水) 11:05
ためしに、
Sub TEST()
MsgBox Range("B3").Offset(1, 0).Value
End Sub
これをフィルターがかかってないときと、フィルタがかかっているときで両方ためしてみてください 同じ結果しか出ないはずです。
（TAKA） 2018/09/12(水) 11:25
また、↓はもともと変ですね。
Set beaf = Range("mituketa1 , mituketa2, mituketa3, mituketa4, mituketa5")
Set fish = Range("mituketa6 , mituketa7, mituketa8 ,mituketa9, mituketa10 ")
変数名のはずなのに文字列にしちゃってるから、無理やり解釈しようとしても、そういう名前のセル（範囲）探すようになりませんか？
もっと言えば、mituketa1～mituketa10には何が格納されている（格納してほしかった）のでしょうか？
とりあえず、ねむねむさんが確認されている
＞mituketa1～mituketa10はDim句でどのように定義しているのだろうか？
の返答がほしいですね。
例えば、セルそのものを格納する予定であったなら、こんな感じになるのでは？
Sub test()
Dim mituketa1 As Range, mituketa2 As Range, mituketa3 As Range
Dim beaf As Range
Set mituketa1 = Worksheets("sheet1").Rows(3).Find(What:="割当", LookAt:=xlPart).Offset(1)
Set mituketa2 = Worksheets("sheet1").Rows(3).Find(What:="いつ", LookAt:=xlPart).Offset(1)
Set mituketa3 = Worksheets("sheet1").Rows(3).Find(What:="なぜ", LookAt:=xlPart).Offset(1)
Set beaf = Union(mituketa1, mituketa2, mituketa3)
End Sub
2018/09/12(水) 12:26 追記
（もこな２） 2018/09/12(水) 11:42
このことについては、少なくとも私にはやりたいことがどのようなことなのかわかってないので何とも言えないですね。
たとえば、"割当"の部分だけで言えば
(1)手動で "Sheet1"の3行目が項目行としてオートフィルタを設定し、抽出もしておく。 (2)手動で "Sheet2"の4行目が項目行としてオートフィルタを設定し、抽出もしておく。 (3)マクロで、 "Sheet1"の項目行から"割当"の列を探す。 (4)マクロで、 "Sheet2"の項目行から"割当"の列を探す。
とここまでは、推測できますけどそのあとが、マクロで実行するところは固定としても
(5)"Sheet1"の対象列のうち1つ目のデータを、"Sheet2"の対象列のうち、項目行の１行下に上書き貼付する。 (5)"Sheet1"の対象列のうち1つ目のデータを、"Sheet2"の対象列のうち、項目行の１行下に挿入する。 (5)"Sheet1"の対象列のうち1つ目のデータを、"Sheet2"の対象列の一番下に追加するよう貼付する。 (5)"Sheet1"の対象列のうち1つ目のデータを、"Sheet2"の対象列の抽出されているものの、１行下に上書き貼付する。 (5)"Sheet1"の対象列のうち1つ目のデータを、"Sheet2"の対象列の抽出されているものの、１つ下に挿入する。
みたいに、やりたいことがどれなのかよくわからないので回答できないです。
（もこな２） 2018/09/12(水) 12:48
sheet1
|[A] |[B] |[C] |[D] |[E] |[F] ← オートフィルタ
[3] |名前 |割当 |いつ |なぜ|状況 |必要なもの
[4] |まだお |なかよし|きょう|BB |やってる |スコップ
[5] |あぶらあげ |ふなか |きょう| |やってない|きもち
[6] |おとうふ |ふつう |あした|CC |やってる |おつきさま
[7] |きびだんご |ふなか |きのう|AA |やってない|ひめ
[8] |おに |なかよし|きのう| |やってる |そのほか
[9] |きみがよ |ふつう |あした|AA |やってる |
[10]|ほうれんそう|なかよし|きのう|DD |やってない|みた
[11]|もりもと |ふつう |あした| |やってる |
[12]|まだお2 |ふなか |きょう|BB |やってない|
[13]|まだお3 |なかよし|あした| |やってる |うらない
sheet2
|[A] |[B] |[C] |[D] |[E] |[F] |[G] ← オートフィルタ
[4] |名前 |何者 |割当 |いつ |なぜ|状況 |必要なもの
[5] |あぶらあげ |たべもの|なかよし|あした|CC |やってる |かがみ
[6] |どりかむ |ひと |ふつう |きのう| |やってない|きぼう
[7] |くろれっつ |もの |ふなか |あした|SS |やってない|すいみん
[8] |おとうふ |ひと |ふなか |あした|AA |やってる |ほんと
[9] |うみ |もの |ふつう |きょう|MK |やってない|なしごれん
[10]|ほし |もの |ふつう |きのう|II |やってない|とまと
[11]|きびだんご |たべもの|ふなか |きょう|AA |やってる |まほう
[12]|ほうれんそう|うた |なかよし|きのう|BA |やってる |けっけ
[13]|まだお |ひと |なかよし|きょう|BB |やってる |スコップ
[14]|おに |ひと |なかよし|きのう| |やってる |そのほか
[15]|きみがよ |うた |ふつう |あした|AA |やってる |ぱそこん
[16]|もりもと |ひと |ふつう |あした| |やってる |がむ
sheet1 オートフィルタで抽出
|[A] |[B] |[C] |[D] |[E] |[F] ← オートフィルタ★"おとうふ"で抽出
[3]|名前 ★ |割当 |いつ |なぜ|状況 |必要なもの
[6]|おとうふ |ふつう |あした|CC |やってる |おつきさま
sheet2 オートフィルタで抽出
|[A] |[B] |[C] |[D] |[E] |[F] |[G] ← オートフィルタ★"たべもの"で抽出
[4] |名前 |何者 ★ |割当 |いつ |なぜ|状況 |必要なもの
[7] |おとうふ |たべもの|ふなか |あした|AA |やってる |ほんと
[10]|きびだんご |たべもの|ふなか |きょう|AA |やってる |まほう
[12]|あぶらあげ |たべもの|なかよし|あした|CC |やってる |かがみ
作業手順
手動：オートフィルタで抽出する
マクロを使ってsheet1の[おとうふ]のデータをsheet2の[おとうふ]のデータで上書き
上書きする項目は"割当", "いつ", "なぜ", "状況", "必要なもの"
手動でオートフィルタを使うため常に一番上にくるデータのみコピペする
わかったこと
命令の重ね掛けは不可(Range、Select)
最初に質問したエラーは項目名に不備があり、見つけられなかったことによるエラー
＃(文字を置き換えたらエラーが出なくなったが目視では違いわからず)
offsetは可視セル上の移動には適用されない
※項目名が見つからない可能性がある場合はエラー処理をする
項目名は固定されていないため今回はFindメゾットを使用→Findメゾットは使えない？？？？？
（トイレの女神） 2018/09/12(水) 14:23
そのうえで、どちらのシートでもA列「名前」内で重複がないということであれば、Vlloup関数やMatch関数＆Index関数でシート間参照すれば事足りそうな気がしますがどうなんでしょうか。
（もこな２） 2018/09/12(水) 16:51
Sub Macro1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, i As Long, j As Long
Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
With Ws1
For i = 4 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Rows(i).Hidden = False Then
For j = 5 To Ws2.Cells(Ws2.Rows.Count, "A").End(xlUp).Row
If Ws2.Rows(j).Hidden = False Then
Ws2.Cells(j, "A") = .Cells(i, "A").Value
Ws2.Cells(j, "C").Resize(1, 5) = .Cells(i, "B").Resize(1, 5).Value
Exit Sub
End If
Next j
End If
Next i
End With
End Sub
（TAKA） 2018/09/12(水) 17:44
Sub Macro1()
Dim Ws1 As Worksheet, Ws2 As Worksheet, i As Long, j As Long
Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")
With Ws1
For i = 4 To .Cells(.Rows.Count, "A").End(xlUp).Row
If .Rows(i).Hidden = False Then
For j = 5 To Ws2.Cells(Ws2.Rows.Count, "A").End(xlUp).Row
If Ws2.Rows(j).Hidden = False Then
Ws2.Cells(j, "C").Resize(1, 5) = .Cells(i, "B").Resize(1, 5).Value
Exit Sub
End If
Next j
End If
Next i
End With
End Sub
（TAKA） 2018/09/12(水) 18:25
(1) 記事番号をコピー (2)「初めての方へ」をクリック (3) (e) [既存の書き込みに書き込む]機能 の最後の行のリンクをクリック (4) 記事番号をペーストして編集ボタンをクリック
編集にならず、記事そのものに飛んだときは、貼り付けた記事番号の後ろに変なスペース入ってないか再確認
（もこな２） 2018/09/12(水) 19:25
Sub test()
Dim dstSH As Worksheet: Set dstSH = Worksheets("Sheet2")
Dim MyRNG As Range, MyROW As Variant
Stop
With Worksheets.Add
'作業用のシートを作成して、"Sheet1"の抽出状態をコピーする。
Worksheets("Sheet1").AutoFilter.Range.Copy .Range("A1")
For Each MyRNG In Intersect(.UsedRange, .UsedRange.Offset(1), .Columns("A"))
'Match関数で"Sheet2"のA列のうち、どの行に検索値があるか調べる
MyROW = Application.Match(MyRNG, dstSH.Columns("A"), 0)
'Match関数で対象行が見つかって、かつ、対象行が非表示でなければコピペを実行
If Not IsError(MyROW) And Not dstSH.Rows(MyROW).Hidden Then
MyRNG.Offset(, 1).Resize(, 5).Copy dstSH.Cells(MyROW, "C")
End If
Next MyRNG
'作業シートの削除
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
※どちらのシートでもA列内で重複がないことが前提です。
（もこな２） 2018/09/12(水) 22:33
最終的にやりたい事は、 シート1の表から、オートフィルタなどで抽出した、任意の行の「割当～必要なもの」の5列分のデータを、 シート2の同じ名前のデータに編集したい。 と言う事で間違いないですか？
幾つか確認ですけど、 1点目、シート1のデータ全てが対象では無く、あくまで任意で指定した1行分のデータだけを変更したい。 と言う事ですか？ 2点目、シート1のデータは例図のように同じ名前は後ろに2や3と付けて、重複されないようになってますか？ 3点目、例図ではシート2のデータも名前に重複が無いですけど、実際のデータも重複なしですか？ それとも「何者」の区分違いで同じ名前が存在しますか？ 4点目、シート1の方には、名前の後ろに2や3がついてるけど、シート2の名前にはついてない。 またシートが逆で、同じようなパターンはありますか？
確認事項が不明ですけど、両方のシートとも名前の重複は無い、且つ任意の1件のデータを書き換え、
名前は完全一致で検索できるとしたら、以下のコードでも出来ます。
シート1だけオートフィルタで1件のみ抽出した状態で実行です。
(2件以上抽出されていたら一番上のデータだけ変更されます。)
(シート2は何もしなくて良いです。)
Sub test()
Dim i As Long
i = Sheets("Sheet1").Range("A4:A1000").SpecialCells(xlCellTypeVisible).Row
Sheets("Sheet1").Range("B:F").Rows(i).Value = Evaluate("=VLOOKUP(A" & i & ",Sheet2!A:G,COLUMN(C:G),0)")
End Sub
（sy） 2018/09/13(木) 03:32
ということであれば、↓をSheet2の該当セル（今回はC5）に入力して、行方向と列方向にそれぞれコピー（フィル）すれば、たとえ項目列が不定でも、わざわざマクロを使わなくても解決できるようにおもいます。
=IFERROR(IF(INDEX(Sheet1!$A$3:$Z$100,MATCH($A5,Sheet1!$A$3:$A$100,0),MATCH(C$4,Sheet1!$A$3:$Z$3,0))="", "",INDEX(Sheet1!$A$3:$Z$100,MATCH($A5,Sheet1!$A$3:$A$100,0),MATCH(C$4,Sheet1!$A$3:$Z$3,0))),"")
syさんがVLOOKUP関数使っていたので、あえてINDEX関数にしてみただけなので、VLOOKUPのほうが良くない？というツッコミは無しで・・・
（もこな２） 2018/09/14(金) 09:45
あれ！？ 皆さんシート２のデータを書き換えになってるけど、 何か私が勘違いしてるのかな？ >作業手順としては sheet2→1にコピー >マクロを使ってsheet1の[おとうふ]のデータをsheet2の[おとうふ]のデータで上書き これってシート１のデータを書き換えって意味と思ったんですけど？
（sy） 2018/09/14(金) 12:32
Dim mori As Worksheet : Set mori = Worksheets("sheet1")
Dim kaze As Worksheet : Set kaze = Worksheets("sheet2")
のときに
With mori mituketa1～5 End With
With kaze mituketa6～10 End With
Set beaf = Range("mituketa1 , mituketa2, mituketa3, mituketa4, mituketa5")
Set fish = Range("mituketa6 , mituketa7, mituketa8 ,mituketa9, mituketa10 ")
beaf.Copy fish.PasteSpecial Paste:=xlPasteValues
という発想になっていたので、「sheet1」をコピーして「sheet2」に貼り付けたい と読んだけど実のところどうなんでしょね
（もこな２） 2018/09/14(金) 12:58
VLOOKUPはともかく、ご提示の式は以下でも同じですよ。 =IFERROR(INDEX(Sheet1!$B$4:$Z$100,MATCH($A5,Sheet1!$A$4:$A$100,0),MATCH(C$4,Sheet1!$B$3:$Z$3,0))&"", "")
（sy） 2018/09/14(金) 19:15
（もこな２） 2018/09/15(土) 09:36
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.