出産前後の痔にはご注意!

VBA初心者の


図2と3を見比べてみてください。
図1から必要な列だけを選択して1列丸ごとコピーするのですが

図2を見てください。1行丸ごと項目でつぶしているところがあり
このままだと1項目づつコピーしなければなりません。その際、コピーするデータ量が一定ではないため、可変行における変動するコピー開始位置の設定が問題となります。

この手の話でよく出る、vbaの最終行指定offset+count    index+countaはいずれも開始位置が固定した上で、終了位置の変動位置に対応するというものであり、この話には対応できません。
コピーした後、値を合計し(vbaのEnd xlup)追加行を挿入しないといけませんが、(vbaのResize10)
いづれも、検索のみでは、開始位置が変動する場合の話はありませんでした。


そこで、考えた結果、フォーマットを変更することにしました(図3)。項目を列の一つと設定し、それにより開始位置を固定した上でデータを全項目一括でコピーすることにしたのです。
開始位置が固定した上で、データ量が変動する、コピー・合計の話はネット上によくあるので、今それを参考にコーディングしてる最中です。

どう思われますか?この話。かなり無駄があるような気がするのですが・・・・

「可変行における変動するコピー開始位置の設」の質問画像

このQ&Aに関連する最新のQ&A

A 回答 (2件)

画像がぼやけて見えない。

補足で画像を大きく(狭い範囲を)あげることが出来ないなら、別質問したら。
色々書いているが、
ーー
自分の思考過程など長々と書いているが
文章でやりたいことの要点を絞れないのか。
また自分の生のデータ(画像)を質問に使わず、質問に適当な長さの、特徴を盛り込んだ、要点が判るデータを考えること。
ーー
左列や、上行に空白セルがあって、例えばデータの開始行や開始列を知りたいなら、End(xlUp)やEnd(xlDoun)を使えないのか。
例データ
A1:B7
ーは空白セルをあらわす
データ1データ2
ー     -
a      -
bx
cy
ーz
ーu
ーーーー
Sub test01()
r = Cells(1, Columns.Count).End(xlToLeft).Column
'MsgBox r
For j = 1 To r
u = Cells(2, j).End(xlDown).Row
'MsgBox u
'MsgBox Rows.Count
d = Cells(Rows.Count, j).End(xlUp).Row
MsgBox j & "列は" & u & "行から" & d & "行までデータがあります"
Next j
End Sub
こういう問題でなければすみません。無視して。
ーー
表現
>図2と3を見比べてみてください。
>どう思われますか?
問題出題者のような表現になっている。質問する立場なのだから、考えて。
    • good
    • 0
この回答へのお礼

質問の仕方がまずいとわかりました。
文章・データで自分のやりたいことを明確にし
それをスクリプトで記述する。

申し訳ありませんでした

お礼日時:2011/12/21 08:54

画質の問題か、添付の図から質問をうまく読み取れない状態ですが。


「図1にある内容をコピーしたい。図2へのコピーだと面倒なので図3の形式にしたい」ですか?

データを例示してみていただけませんか?
    • good
    • 0
この回答へのお礼

はい、そのとおりです。図2の形式だと1項目づつのコピーなので、データ量によりコピー開始位置が変動してしまい、VBAでその位置を指定するのが困難です。

例)タイプ1(全30件等)のABC(2・2・4等)の値をコピーした後に、タイプ2(全50件等)の  ABCの値をコピーする
  またはタイプ5のABCの値をコピーした後にタイプ4のABCの値をコピーする
  そして最終的に全タイプのコピー、合計(150・180・190等)、不足行の挿入




図の3の形式だと項目名を列の1つとすることになるので、開始位置を固定した上での変動するデータのコピー・合計の話になると思いました。

例)タイプ12345のABCの値を一括でコピー、合計(200件分)、不足行(全200行コピー、不足分50行追加)の挿入

お礼日時:2011/12/19 00:30

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QVBA コピーを有効行までループをする方法

VBAをはじめたばかりの初心者です。
業務でマクロ処理をするよう言われましたが、苦戦しております。
なんとか今週中にしあげなければならない状況で、ご存知の方がいらっしゃれば助けていただければと思います。

1行目・・・項目が記載されています。
2行目以降・・・A列~G列・I~K列に住所などの情報があり、H列とL列にはとある計算式をいれています。
件数は約500件(500行)程度で、毎回変更します。

H2とL2に計算式を入れて、
セルH2の値をH3にコピー、セルL2の値をL3にコピーするマクロが自動記録で次のようにできました。
Range("H2").Select
Selection.Copy
Range("H3").Select
ActiveSheet.Paste
Range("L2").Select
Application.CutCopyMode = False
Selection.Copy
Range("L3").Select
ActiveSheet.Paste

これを、H4・L4、H5・L5・・・・と繰り返してコピーをしていき、データがなくなったらループを修了するという記述をしたいのですが、わかりません。
いろいろネットで探してみたのですが、データ数を指定するやり方(?)ではなく、「Do~Loop」を使った方法でやりたいと思っております。

どなたか教えていただけませんでしょうか。
宜しくお願いいたします。

VBAをはじめたばかりの初心者です。
業務でマクロ処理をするよう言われましたが、苦戦しております。
なんとか今週中にしあげなければならない状況で、ご存知の方がいらっしゃれば助けていただければと思います。

1行目・・・項目が記載されています。
2行目以降・・・A列~G列・I~K列に住所などの情報があり、H列とL列にはとある計算式をいれています。
件数は約500件(500行)程度で、毎回変更します。

H2とL2に計算式を入れて、
セルH2の値をH3にコピー、セルL2の値をL3に...続きを読む

Aベストアンサー

方法はいくつかあると思いますが。。。

'-------------------------------------
Sub Test1()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").AutoFill Range("H2:H" & Lastrow)
 Range("L2").AutoFill Range("L2:L" & Lastrow)
End Sub
'--------------------------------------
Sub Test2()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").Copy Range("H3:H" & Lastrow)
 Range("L2").Copy Range("L3:L" & Lastrow)
End Sub
'-----------------------------------
Sub Test3()
 Dim R As Long
 For R = 3 To Cells(Rows.Count, "A").End(xlUp).Row
   Range("H2").Copy Cells(R, "H")
   Range("L2").Copy Cells(R, "L")
 Next R
End Sub
'---------------------------------

A列のデータで最終行を判断してます。
 

方法はいくつかあると思いますが。。。

'-------------------------------------
Sub Test1()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").AutoFill Range("H2:H" & Lastrow)
 Range("L2").AutoFill Range("L2:L" & Lastrow)
End Sub
'--------------------------------------
Sub Test2()
 Dim Lastrow As Long
 Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
 Range("H2").Copy Range("H3:H" & Lastrow)
 Range("L2").Copy Range("L3:L" &...続きを読む

Q条件にマッチする行を抽出するVBAを教えてください

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だけのリストとなり、印刷するだけでいいようにしたいわけです。

本来ならオートフィルタですればいい話ですが、どうしてもD3という離れたセルの入力内容で抽出したいのです。

VBAでなく、D3のセル内容を使ってD8~のオートフィルタが行えるなら、それが一番理想です。
が、自分でやってみた限りはできませんでした。

フィルタオプションならどうかとやってみたところ、一回目は抽出できました。しかし、D3またはE3の条件を変更しても、リアルタイムで抽出結果が切り変わらない。
フィルタオプションの抽出結果を別のセルに出せばいいのですが、そうすると無駄な情報が残り、ただ印刷しただけでOK・・というわけにいきません。(印刷範囲を区切るとかでなく、シートの見栄えが必要な情報だけにならないと…扱う初心者が混乱します)


自分なりには、VBAにより、 D3・E3のセル内容が書き換わったらフィルタオプションの抽出結果をいったん同シートの別セルに出し、抽出結果部分だけを別のシートにカット&ペースト成形。そのシートを印刷させればよい。
という考えになりましたが、やってみたら、なぜか別のブックに同じものが形成され、抽出した結果だけ単独のデータにできません。

そもそももっと良いアイデアがあればそれをおしえていただきたい。
あるいは、VBAで目的達成できるように問題点をご指摘ください。


一応、プログラムを書いておきます



■添付画像のデータが入っているシート(『一覧』という名前のシート)内コード

Private Sub Worksheet_Change(ByVal Target As Range)
'

If Target.Column = 4 Then
If Target.Row >= 3 And Target.Row <= 3 Then

Call Filter
Call copy

End If
End If

End Sub

■サブルーチンFilter() 標準モジュールに記載
Sub Filter()

' Filter Macro

'フィルタオプションを使って同シート内「D1100」以降に抽出結果を出します
ActiveWorkbook.Worksheets("一覧").Select

'一覧表はD7~F1000。検索条件はD2~F3までの範囲に名前を付けたもの
Range("一覧表").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"検索条件"), CopyToRange:=Range("D1100"), Unique:=False

Range("A1").Select
End Sub


■サブルーチンcopy() 標準モジュールに記載
Sub copy()
'
' copy Macro
'
'抽出された内容(45行目~100行目まで)を別のシートにコピーします

ActiveWorkbook.Worksheets("一覧").Select
Rows("45:100").Select
Selection.Cut
ActiveWorkbook.Worksheets("抽出結果").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Range("A1").Select


End Sub

アイデア、またはVBAプログラムの例を教えていただきたく、質問させていただきます

excelで、添付画像のようなリスト管理表を作っています。
リストは600行近くになります。
やりたいことは、D3またはE3に商品名または保管庫を入力すると、リスト内から、合致する行だけが抽出される、というもの。
D3とE3は、どちらか片方にのみ条件が入る。D3とE3の内容を変更するとリアルタイムで抽出結果も変更されるようにしたい。
触る人が初心者なので、難しい作業を一切せずに、D3またはE3を打ちかえるだけで必要な項目だ...続きを読む

Aベストアンサー

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼び出した画面に書き込み、入力が終わったら、ファイルタブ→終了してexcelに戻る、としてください。

それと、クライテリアを使うと、倉庫1の検索で倉庫10以降もピックアップされてしまうので、1は全角で10以降は半角にするなど、元ネタに区別をしてください。

また、利用者のなかにビギナーがいるのであれば、セルのロックと保護を使い、一覧シートのD3:E3しか操作出来ないようにする、入力規則を使って、商品1,商品2といったリストから選ばせる、等の工夫も考えられます。それらをどう併用するかによって適切なコードも変わってきますので、細部はご自身で調整してください。

Private Sub Worksheet_Change(ByVal Target As Range)

If Application.Intersect(Target, [D3:E3]) Is Nothing Then Exit Sub

Worksheets(”抽出結果”).[A1:C1000].ClearContents

Range(”一覧表”).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
(”検索条件”), Copytorange:=Worksheets(”抽出結果”).Range(”A1”)

End Sub

追記:
では、当方で検証したサンプルコードを載せますので、ご参考に。結果提示用に「抽出結果」と名付けたまっさらなシートを予め用意しておいてください。

と、その前に注意点。
ご質問内容では、シートモジュールや標準モジュール等、複数のモジュールにコードが分散していますが、今回の処理内容では、モジュールを分ける意味がありません。シートモジュールのワークシートチェンジイベント1本で十分です。従って、ご案内するコードは、一覧表のあるシートのシート見出しを右クリック→コードの表示から呼...続きを読む


人気Q&Aランキング