Excel VBA質問箱 IV

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

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


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

100 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80483】Re:EXCEL2010 VBA オートフィルタ

りょうた - 19/2/18(月) 5:49 -


	引用なし

	パスワード

ありがとうございました

・ツリー全体表示


	【80482】Re:EXCEL2010 VBA オートフィルタ

マナ - 19/2/17(日) 21:50 -


	引用なし

	パスワード

▼りょうたさん：

手作業で抽出できないものは、マクロでもできません。
オートフィルタでなく、
フィルタオプションを使用してください。
（これで３回めです）

・ツリー全体表示


	【80481】Re:EXCEL2010 VBA オートフィルタ

りょうた - 19/2/17(日) 21:38 -


	引用なし

	パスワード

ピンク様

ありがとうございます

1つ目はC列の年月日が大きくて、
AQ列のABCを選択してデータを表示

2つ目はC列の年月日とAQ列のAEWQを選択して
データを表示

したいのですが
ABCはmaxdayだけが、対象になり
AEWQはmindayとmaxdayが、対象になるのですか？

・ツリー全体表示


	【80480】Re:検索フォームの動作について

tarutaru - 19/2/17(日) 20:50 -


	引用なし

	パスワード

マナ様

アドバイスありがとうございます。
２通り作成し、どちらがいいか試してみたいと思います。

・ツリー全体表示


	【80479】Re:行のデータをクリアして1行づつ繰り上...

ノンボ - 19/2/17(日) 20:39 -


	引用なし

	パスワード

▼ピンクさん：
>参考に
>Sub Test6()
>　　Dim myRow As Long, i As Long, j As Long
>　　myRow = 2: j = 9
>　　Do Until myRow > 10
>　　　　If Cells(myRow, "B").Value = 0 Or Cells(myRow, "B").Value = "" Then
>　　　　　　myRow = myRow + 1
>　　　　ElseIf Cells(myRow, "B").Value > 0 And Cells(myRow, "U").Value > 0 Then
>　　　　　　myRow = myRow + 1
>　　　　ElseIf Cells(myRow, "U").Value = 0 Or Cells(myRow, "U").Value = "" Then
>　　　　　　For i = myRow To j
>　　　　　　　　Cells(i + 1, 1).Resize(, 23).Copy Cells(i, 1)
>　　　　　　Next
>　　　　　　Cells(j + 1, 1).Resize(, 23).ClearContents
>　　　　　　Cells(j + 1, "G").FormulaR1C1 = "=RC[-5]*8%"
>　　　　　　Cells(j + 1, "K").FormulaR1C1 = "=RC[-9]+RC[-4]"
>　　　　　　Cells(j + 1, "U").FormulaR1C1 = "=RC[-10]-RC[-4]"
>　　　　　　j = j - 1
>　　　　End If
>　　Loop
>　　MsgBox "終わり"
>End Sub

ピンクさん、参考のコードをかいていただきましてたいへんありがとうございました。とてもうまくいきました。もっと勉強するように努力します。
本当にありがとうございました。

・ツリー全体表示


	【80478】Re:EXCEL2010 VBA オートフィルタ

ピンク - 19/2/17(日) 19:31 -


	引用なし

	パスワード

>※１と※２のデータをシートに一度で表示するには
>どのようにしたらよいでしょうか？

With ActiveSheet.Range("$A$1:$AW" & LastRow)
　　.AutoFilter Field:=3, Criteria1:=MaxDay, Operator:=xlOr, Criteria2:=MinDay
　　.AutoFilter Field:=43, Criteria1:="ABC", Operator:=xlOr, Criteria2:="AEWQ"
End With

・ツリー全体表示


	【80477】Re:検索フォームの動作について

マナ - 19/2/17(日) 18:55 -


	引用なし

	パスワード

▼tarutaru さん：

現行とかなり変わってしまうかもしれませんが
こんな感じが一番すっきりしそうに思いました。
（フィルタオプション案です）

１）条件設定：コンボボックス、テキストボックス
　　　↓
２）コマンドボタン
　　　↓
３）フィルタオプションでSheet3に抽出
　　　↓
４）Sheet3のデータをリストボックスに表示
　　　↓
５）条件変更：コンボボックス、テキストボックス
　　　↓
　　繰り返し

・ツリー全体表示


	【80476】Re:行のデータをクリアして1行づつ繰り上...

ピンク - 19/2/17(日) 18:53 -


	引用なし

	パスワード

参考に
Sub Test6()
　　Dim myRow As Long, i As Long, j As Long
　　myRow = 2: j = 9
　　Do Until myRow > 10
　　　　If Cells(myRow, "B").Value = 0 Or Cells(myRow, "B").Value = "" Then
　　　　　　myRow = myRow + 1
　　　　ElseIf Cells(myRow, "B").Value > 0 And Cells(myRow, "U").Value > 0 Then
　　　　　　myRow = myRow + 1
　　　　ElseIf Cells(myRow, "U").Value = 0 Or Cells(myRow, "U").Value = "" Then
　　　　　　For i = myRow To j
　　　　　　　　Cells(i + 1, 1).Resize(, 23).Copy Cells(i, 1)
　　　　　　Next
　　　　　　Cells(j + 1, 1).Resize(, 23).ClearContents
　　　　　　Cells(j + 1, "G").FormulaR1C1 = "=RC[-5]*8%"
　　　　　　Cells(j + 1, "K").FormulaR1C1 = "=RC[-9]+RC[-4]"
　　　　　　Cells(j + 1, "U").FormulaR1C1 = "=RC[-10]-RC[-4]"
　　　　　　j = j - 1
　　　　End If
　　Loop
　　MsgBox "終わり"
End Sub

・ツリー全体表示


	【80475】Re:検索フォームの動作について

tarutaru - 19/2/17(日) 17:33 -


	引用なし

	パスワード

マナ様

お忙しい中、懇切丁寧にご教示いただき、大変ありがとうございます。

後日、ご教示いただいたステートメントで再構成したいと思います。
結果につきましても、報告させていただきます。

マナ様のような上級者が周りにいないもので、本当に助かります。

今後ともよろしくお願いいたします。

・ツリー全体表示


	【80474】Re:行のデータをクリアして1行づつ繰り上...

ノンボ - 19/2/17(日) 11:35 -


	引用なし

	パスワード

　ありがとうございました。

　いろいろ教えていただきまして助かりました。あとは自分で努力してみます。
　すみませんでした。

・ツリー全体表示


	【80473】Re:検索フォームの動作について

マナ - 19/2/17(日) 11:19 -


	引用なし

	パスワード

▼マナさん：

>With ListBox2
>　　Worksheets("sheet3").Cells(3, 1).Resize(.ListCount, 10).Value = .List
>End With

間違えました。10でなく20でした。

Worksheets("sheet3").Cells(3, 1).Resize(.ListCount, 20).Value = .List

・ツリー全体表示


	【80472】Re:行のデータをクリアして1行づつ繰り上...

γ - 19/2/17(日) 11:00 -


	引用なし

	パスワード

フォーマットの不具合ってどういうことですか？

(1)結合セルはできるだけ使わないようにしたほうがよいです。
　（直ぐには対応できないかもしれないが）
(2)0と比較するところでは、空白と0を比較すると Trueになるのでは？
　 IsEmpty関数を調べて下さい。

そのほか、
Range("U" & i).Rowsの .Rowsというものの意味が不明です。不要です。
Range("U" & i).Valueでよいのでは？

出掛けますので、しばらく反応できません。

・ツリー全体表示


	【80471】Re:EXCEL2010 VBA オートフィルタ

マナ - 19/2/17(日) 10:39 -


	引用なし

	パスワード

▼りょうたさん：

ですから、フィルタオプションを使用するとよいです。
オートフィルタの高機能版です。

手作業で実行できますので試してみてください。
ネット検索で、操作方法を説明したものが簡単にみつかります。

実行できたら、それをマクロ記録するとコードが得られますので
それを修正して仕上げることになります。

・ツリー全体表示


	【80470】Re:検索フォームの動作について

マナ - 19/2/17(日) 10:31 -


	引用なし

	パスワード

▼tarutaru さん：

１）決定ボタンで転記する方法
配列等を使用した方が効率はよいかもしれませんが
一番簡単なのは、条件を満たした行を都度コピペするというもの。
Worksheets("2019.4").Rows(i + 2).Copy Worksheets("sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1)

２）リストボックスから丸ごと転記する方法
リストボックスには、20項目すべて取り込み
表示したくない項目の列幅を0に設定
そうすると、Listプロパティで取得した配列を書き込むだけ。
With ListBox2
　　Worksheets("sheet3").Cells(3, 1).Resize(.ListCount, 10).Value = .List
End With

３)フィルタオプションを使う方法
検索フォームで選んだ条件に基づき
一覧シートから抽出しSheet3に転記します。
抽出条件は、セル範囲として指定が必要なので
作業用セルを用意し、検索フォームから転記します。
まずはフィルタオプションの操作を手作業で理解することです。

・ツリー全体表示


	【80469】Re:行のデータをクリアして1行づつ繰り上...

ノンボ - 19/2/17(日) 9:47 -


	引用なし

	パスワード

▼γ さん：
>それでは、あなたのコードをステップ実行してみてください。
>F8キーを押しながら1行ずつ実行するものです。
>どこで想定と違うことが起きているのか、
>原因を調べてみて下さい。
># こうした作業をデバッグといいますが、
># コード作成と一体になるものです。

γさん返信ありがとうございます。
言われたようにコードを実行してみましたら、end ifの前のRows(i)=""でフォーマットで不具合が生じました。Next iまですべて実行するとフォーマットのセルが解除されて、データが消えてしまいます。どのように編集すればよろしいでしょうか。

・ツリー全体表示


	【80468】Re:行のデータをクリアして1行づつ繰り上...

γ - 19/2/17(日) 8:47 -


	引用なし

	パスワード

それでは、あなたのコードをステップ実行してみてください。
F8キーを押しながら1行ずつ実行するものです。
どこで想定と違うことが起きているのか、
原因を調べてみて下さい。
# こうした作業をデバッグといいますが、
# コード作成と一体になるものです。

・ツリー全体表示


	【80467】Re:行のデータをクリアして1行づつ繰り上...

ノンボ - 19/2/17(日) 8:18 -


	引用なし

	パスワード

▼γ さん： >合計金額というのはどの列にあるんですか？ > >> 入金金額により差額が0かそうでないかを判断し、 >> 2行目から10行目までのフォーマットを崩さずに、 >> 0の場合は、行を1行ずつ繰り上げていきます。 >> 0でない場合はデータをそのままにしたく、 >ここの操作を箇条書きにして提示してください。 >特に、 >行を1行ずつ繰り上げる >というところを手作業でやるとして、 >正確に箇条書きしてください。 > >あなたのコードは間違っている、 >というか、想定していることと違う結果になるわけだから、 >そのコードは参考にできないのです。 >間違っているもので説明したことにするのは余りに大胆です。説明がうまくなく申し訳ありません。本体金額はＢ～Ｆ列、税額はＧ～Ｊ列、合計金額がＫ～Ｐ列、入金金額はＱ～Ｔ列差額はＵ～Ｗ列、それぞれセルが結合されています。月ごとに売上金額があります。毎月入金金額が2～5行目の入金金額欄（Ｑ～Ｔ）列に入力されます。入金金額が合計金額と一致したら差額は0になりますが、合計金額と一致しない場合差額が生じます。差額が0か0でないか判断して、0のばあいはその行をクリアさせて、下の行を1行づつ繰り上げてコピーしたいのです。0ない場合はクリアさせないでそのままにしたいです。行を1行ずつ繰り上げるのを手作業でおこないますと1行ずつコピーして貼り付けます。それを自動化させたいのです。下記フォーマットの表をあらためて表示します。 A列　　　Ｂ～Ｆ列　Ｇ～Ｊ列　Ｋ～Ｐ列　　Ｑ～Ｔ列　　Ｕ～Ｗ列　　　　　　　　　　　　　　　　　　　　　月　　　　本体金額　　税額　　合計金額　　入金金額　　差額 3月　　　　60000　　　 4800　　64800　　　 64800　　　　0 4月　　　　50000　　　 4000　　54000　　　 54000　　　　0 5月　　　　30000　　　 2400　　32400　　　 32400　　　　0 6月　　　　50000　　　 4000　　54000　　　 54000　　　　0 7月　　　　35000　　　 2800　　37800　　　 37800　　　　0 8月　　　　30000　　　 2400　　32400　　　　　 0　　　32400 9月　　　　25000　　　 2000　　27000 10月　　　 50000　　　 4000　　54000 11月　　　 40000　　　 3200　　43200 よろしくお願いします。

・ツリー全体表示


	【80466】Re:検索フォームの動作について

tarutaru - 19/2/17(日) 7:42 -


	引用なし

	パスワード

マナ様

はい。始めは「決定」ボタン１つで行おうと思い、「抽出」ボタンは作成していませんでした。
ところが、最初に投稿した質問欄にあるように、その構文ではListBox1に抽出されたListのどれかを一度選択しなければ、Sheet3にそのデータが反映されません。
マナ様のおっしゃるとおり、できれば簡潔にできるようにしたいのですが何分知識不足で…。
もし、よろしければ、フィルタオプションを含めた具体的なステートメントをご教示いただけますと幸いです。

他の方の質問対応でお忙しい中、お時間のある時で構いませんので、大変申し訳ありませんが、ご教示よろしくお願いいたします。

・ツリー全体表示


	【80465】Re:EXCEL2010 VBA オートフィルタ

りょうた - 19/2/17(日) 4:56 -


	引用なし

	パスワード

マナ様

ありがとうございます

１つ目と２つ目の条件で、抽出したいです
２回のオートフィルタの結果を一度で表示したいです

・ツリー全体表示


	【80464】Re:検索フォームの動作について

マナ - 19/2/17(日) 0:03 -


	引用なし

	パスワード

▼tarutaru さん：

ListBox1の全データを転記する場合の別案です。

リストボックスには、全項目取り込んでおいて、
不要な項目は、非表示にしておけば、
Sheet3には、リストボックスからの単純な転記ですみそうです。

あるいは、フィルタオプションで転記というのも簡単そうです。

・ツリー全体表示


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

100 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free