Excel VBA質問箱 IV

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

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


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

228 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77886】Re:ソートとフィルタの繰り返し処理

γ - 16/1/17(日) 20:24 -


	引用なし

	パスワード

βさんご指摘の点は、たしかに重要な検討ポイントですね。

2010で導入されたRANK.EQを使いましたので、
2007以前のバージョンでは動きません。
（それで、バージョン記載に言及しました。
　2007以前では単にRANK関数を使う）

ところで、今のコードでは、
元データをソートしてしまっています。

ソートしてはまずければ、
(1)元データのコピーを持っておくか
もしくは、
(2)ソートをせずに、
　（ソートしなくても順位判定、書き込みは可能。
　　今のコードでそのまま動く。）
　 Sheet2に転記してから、結果を
　日付（昇順）、得点（降順）でソート
すれば良いはずです。

・ツリー全体表示


	【77885】Re:ソートとフィルタの繰り返し処理

β - 16/1/17(日) 20:03 -


	引用なし

	パスワード

▼みかさん：

すでにγさんからコードも提示されていますので、これを元にして解決ということになろうかと思いますが念のため。

たとえば

A 100
B 100
C 100
D　90
E　90
F　80
G　80
H　70

こんな点数だったとして

考え方としては

A,B,Cが 1位、D,E は 4位
A.B,Cが 1位、D,E が 2位、F,G が 3位

いずれも、考え方としては間違っていませんね。
どちらの基準で考えるかにより、3位以内の人は、誰と誰なのかが違ってきます。

今回は、どちらで考えていますか？

・ツリー全体表示


	【77884】Re:ソートとフィルタの繰り返し処理

γ - 16/1/17(日) 19:28 -


	引用なし

	パスワード

返事を待っていましたが、こちらも平日は時間が余り採れないし、
あきらめて、一例を書きます。
検証を十分にしていないので、そちらでよく検討してください。

なお、人に依頼するのであれば、
テストデータ（サンプルデータ）くらい提示してください。
また、ExcelのVersionも示す必要があります。

Sub test()
　　Dim dic　　　　 As Object
　　Dim k　　　　　 As Long
　　Dim r　　　　　 As Range
　　Dim myRange　　 As Range
　　Dim myRange2　　As Range
　　Dim myRange3　　As Range
　　Dim e　　　　　 As Variant
　　Dim kaisu　　　 As Long
　　Dim c　　　　　 As Long
　　
　　'現在のアクティブシートを作業対象とする（指定したほうがベターかも）
　　
　　'ブロックの数を取得
　　kaisu = (Cells(1, Columns.Count).End(xlToLeft).Column + 1) \ 7
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For k = 1 To kaisu
　　　　c = 7 * (k - 1) + 1
　　　　dic.RemoveAll
　　　　
　　　　'(1)重複を除いた日付を取得
　　　　For Each r In Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
　　　　　　dic(r.Value) = Empty
　　　　Next
　　　　
　　　　'(2)日付（昇順）得点（降順）でソート
　　　　Call mySort(c)
　　　　
　　　　'(3)各日付単位に、Rank.EQ関数を使って順位を付ける
　　　　Set myRange = Cells(1, c).CurrentRegion　　　　　　　'見出しを含む表
　　　　Set myRange2 = Intersect(myRange, myRange.Offset(1)) '見出し除く部分
　　　　
　　　　For Each e In dic.keys
　　　　　　myRange.AutoFilter Field:=1, Operator:=xlFilterValues _
　　　　　　　　　　, Criteria2:=Array(2, e)　　　　　　　　'日付で抽出
　　　　　　Set myRange3 = myRange2.Columns(5).SpecialCells(xlCellTypeVisible)
　　　　　　
　　　　　　'順位をつける（ワークシート関数Rank.EQを使う(同一順位を考慮））
　　　　　　For Each r In myRange2.Columns(6).SpecialCells(xlCellTypeVisible)
　　　　　　　　r.Value = Application.Rank_Eq(r.Offset(, -1), myRange3, 0)
　　　　　　Next
　　　　　　myRange.AutoFilter
　　　　Next
　　　　
　　　　'(4)3位以内だけをSheet2に転記
　　　　myRange.AutoFilter Field:=6, Criteria1:="<=3", Operator:=xlAnd
　　　　myRange.Copy
　　　　Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(2).PasteSpecial
　　　　myRange.AutoFilter
　　Next
End Sub

Function mySort(k As Long)　'列目から始まるブロックに関してソート
　　With ActiveSheet.Sort
　　　　.SortFields.Clear
　　　　
　　　　'日付の昇順
　　　　.SortFields.Add Key:=Cells(2, k) _
　　　　　　　　, SortOn:=xlSortOnValues, Order:=xlAscending _
　　　　　　　　, DataOption:=xlSortNormal
　　　　
　　　　'得点の降順
　　　　.SortFields.Add Key:=Cells(2, k + 4) _
　　　　　　, SortOn:=xlSortOnValues, Order:=xlDescending _
　　　　　　, DataOption:=xlSortNormal
　　　　
　　　　.SetRange Cells(1, k).CurrentRegion
　　　　.Header = xlYes
　　　　.MatchCase = False
　　　　.Orientation = xlTopToBottom
　　　　.SortMethod = xlPinYin
　　　　.Apply
　　End With
End Function

・ツリー全体表示


	【77883】Re:Private Sub Worksheet_BeforeDouble...

とく - 16/1/17(日) 19:22 -


	引用なし

	パスワード

▼β さん：
ありがとうございます。
出来ました。

感謝、感謝、感謝です。

本当にどうもありがとうございました。

また、分からないことがあったらよろしくお願いいたします。

　　　　　　　　　　　　　　　　　　　　　　　　　とく

・ツリー全体表示


	【77882】Re:Private Sub Worksheet_BeforeDouble...

β - 16/1/17(日) 18:58 -


	引用なし

	パスワード

▼とくさん：

たとえば以下。
なお、指定領域内であっても、間違ったセルをダブルクリックして色を付けた。
しまった！！
という場合に、再度、そのセルをダブルクリックすれば色が消えるようにしてあります。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim myColor As Long
　　
　　If Not Intersect(Target, Range("A1:A30")) Is Nothing Then
　　　　myColor = vbRed
　　ElseIf Not Intersect(Target, Range("B1:B30")) Is Nothing Then
　　　　myColor = vbBlue
　　ElseIf Not Intersect(Target, Range("C1:C30")) Is Nothing Then
　　　　myColor = vbGreen
　　　　
　　End If
　　
　　If myColor = 0 Then Exit Sub
　　
　　Cancel = True
　　
　　If Target.Interior.ColorIndex = xlNone Then
　　　　Target.Interior.Color = myColor
　　Else
　　　　Target.Interior.ColorIndex = xlNone
　　End If
　　
End Sub

・ツリー全体表示


	【77881】Private Sub Worksheet_BeforeDoubleCli...

とく - 16/1/17(日) 17:04 -


	引用なし

	パスワード

セルをクリックすれば、色が付くというマクロですが、これをA1:A30は、赤で、B1：B30までは青、C1：C30までは緑という風にしたいのですが、うまく出来ません。
下記では、１色（1エリア）はできるのですが、、、、、
当方、初心者です。教えて下さい。
よろしくお願い申し上げます。。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub
If Target.Interior.ColorIndex = xlNone Then
Target.Interior.ColorIndex = 3
Else
Target.Interior.ColorIndex = xlNone
End If
Cancel = True
End Sub

・ツリー全体表示


	【77880】Re:規定数で区切るには

karasu - 16/1/17(日) 2:10 -


	引用なし

	パスワード

γ さん、こんにちは。

　夜勤終わりで只今帰宅いたしました。

>　「それ」って何を指していますか。何か心あたりでも？

　γさんが書かれた

>> ># それにしてもどこかで聞いたような質問だなあ。
>> ># 質問したまま放置しているわけだが、人として、気にならないのかなあ。

　上記文面です。まったく心当たりがございません。

>　「指定数量で区切り」というタイトルでほぼ同様の質問があったのですが、
>　違ったですか。それは失礼しましたね。

　いえいえ、気になさらずに。

>　βさんのものに手を加えるなら、判定条件に手を入れるのと、
>　加算後のboxという変数も配列に加えて、dictionaryに保存して、
>　一括書き出しすれば良いと思いますよ。

　ご助言ありがとうございます。参考にさせていただきます。

・ツリー全体表示


	【77879】Re:規定数で区切るには

γ - 16/1/16(土) 23:52 -


	引用なし

	パスワード

> ># それにしてもどこかで聞いたような質問だなあ。
> ># 質問したまま放置しているわけだが、人として、気にならないのかなあ。
>
>　　初耳です。それは私ではありません。私は以前にも質問させていただきましたが
>　お礼のコメントは必ずしております。『別にあなたのことを言ったわけではない』
> と言われそうですが・・・。
　
　「それ」って何を指していますか。何か心あたりでも？
　
　年齢を重ねたかたなら、そんなことはしないだろうが、
　たぶん若い方なんでしょうね、マナーを守らない失礼千万な人がいて困るんですよ。
　「指定数量で区切り」というタイトルでほぼ同様の質問があったのですが、
　違ったですか。それは失礼しましたね。

　βさんのものに手を加えるなら、判定条件に手を入れるのと、
　加算後のboxという変数も配列に加えて、dictionaryに保存して、
　一括書き出しすれば良いと思いますよ。

・ツリー全体表示


	【77878】Re:ソートとフィルタの繰り返し処理

γ - 16/1/16(土) 23:04 -


	引用なし

	パスワード

▼みかさん：
>他のサイトなども見ながら奮闘中ですが
A列からF列までを対象にして、できている、ないし奮闘中のコードを
提示してみてはいかがですか？

>納期まで時間がなく困っております。
納期ですか。

・ツリー全体表示


	【77877】ソートとフィルタの繰り返し処理

みか - 16/1/16(土) 23:00 -


	引用なし

	パスワード

大量に同じ処理を行わなければならないのですが、
どのようにVBAを書けばよいのか分かりません。
お手数をおかけしますが、ご教授いただけますと幸いです。

Sheet1に下記のように6列(A～F列、H～M列)をひとまとまりとし、
1列空けて、次の行からまた同じヘッダーのデータが入っています。

A列　B列　C列　D列　E列　F列　 G列　 H列　I列 J列　K列　L列　M列 …
------------------------------------------------------------------------------
日付ｸﾗｽ名前性別得点順位　<空白> 日付ｸﾗｽ名前性別得点順位　…
------------------------------------------------------------------------------
1/5　A　 ●●　女　 57　　　　　　　　1/6　C　△△　男　　78　
1/9　B　 □□　男　 90　　　　　　　　1/17 A　××　男　　95　

各まとまりごとに日付(昇順)、得点(降順)でソートした後、
順位列に日付毎の順位を入力し、オートフィルタで各日の順位が1～3のデータを
Sheet2に張り付けるということを、繰り返したく思います。
また、Sheet1の列は今後増える可能性があるため、最終列を自動で取得したいです。

他のサイトなども見ながら奮闘中ですが
納期まで時間がなく困っております。お知恵をいただけますと幸いです。

・ツリー全体表示


	【77876】Re:オートフィルターの絞込列と抽出結果...

綾香 - 16/1/16(土) 17:17 -


	引用なし

	パスワード

β様

早々にご教授いただきありがとうございます！

オートフィルタで無事に処理することができました。
処理時間も気になるほどではなく、大変助かりました。
いただいたフィルタオプション処理についても勉強してみます！

取り急ぎ御礼まで。

・ツリー全体表示


	【77875】Re:規定数で区切るには

karasu - 16/1/16(土) 13:19 -


	引用なし

	パスワード

ウッシさんこんにちは

　ご回答、ありがとうございます。
大変助かります。組み込み検証まで多少時間がかかりますが活用させて
頂きます。このたびはどうもありがとうございました。

まずは御礼のご挨拶まで。

・ツリー全体表示


	【77874】Re:規定数で区切るには

karasu - 16/1/16(土) 13:08 -


	引用なし

	パスワード

γ さん、こんにちは。

>それもそうかもしれないが、まずはコードをよく理解する必要があるでしょう。

　もちろんです。理解しないことにはファイルに組み込むことはできないことは
解っているつもりです。
　回答してくださっている方々の文を読んでもチンプンカンプンな私です。
自分の作ったエクセルファイルに組み込んで試行錯誤しながら使ってくれる
現場の人に満足(楽に)してもらえたらと奮闘してます。

>他人をコード制作機械かなにかのように考えていませんか？

　そのようには考えておりません。
独学で学んできた定年間近の私には時間がありません。若手にもマクロやVBAを
勉強してほしいのですがなかなか育たない(その気がない)のが現状です。

># それにしてもどこかで聞いたような質問だなあ。
># 質問したまま放置しているわけだが、人として、気にならないのかなあ。

　初耳です。それは私ではありません。私は以前にも質問させていただきましたが
お礼のコメントは必ずしております。『別にあなたのことを言ったわけではない』
と言われそうですが・・・。

　貴重なアドバイスありがとうございました。

・ツリー全体表示


	【77873】Re:規定数で区切るには

ウッシ - 16/1/16(土) 9:08 -


	引用なし

	パスワード

こんにちは

差し替えで、標準モジュールの先頭から、

Option Explicit
Const 規定数 As Long = 10
Const 不足分 As Long = 2
Const 余剰分 As Long = 2

Sub test1_0()
　　Dim sh1 As Worksheet
　　Dim sh2 As Worksheet
　　Dim wsh As Worksheet
　　Dim r　 As Range
　　Dim s　 As Range
　　Dim i　 As Long
　　Dim j　 As Long
　　
　　Set sh1 = Worksheets("Sheet1")
　　Set sh2 = Worksheets("Sheet2")
　　Set wsh = Worksheets.Add
　
　　Application.ScreenUpdating = False
　
　　sh2.Range("A1").CurrentRegion.Offset(1).ClearContents
　
　　wsh.Range("A1:C1").Value = sh1.Range("A1:C1").Value
　　wsh.Range("D1").Value = "グループ"
　
　　i = 2
　　For Each r In sh1.Range("A2", sh1.Range("A2").End(xlDown))
　　　　wsh.Cells(i, 1).Resize(r(1, 3), 3).Value = r.Resize(, 3).Value
　　　　i = i + r(1, 3)
　　Next
　
　　Call test1_1(wsh)
　　
　　wsh.Range("A1").CurrentRegion.Subtotal _
　　　　GroupBy:=4, Function:=xlCount, TotalList:=Array(3), _
　　　　Replace:=True, PageBreaks:=False, SummaryBelowData:=True
　
　　Set s = wsh.Range("D2", wsh.Range("D2").End(xlDown).Offset(-1, 0)) _
　　　　　　　　　　.Offset(, -3).SpecialCells(xlCellTypeBlanks)
　　
　　
　　For Each r In s
　　　　r.Offset(-1, 0).Resize(, 2).Copy _
　　　　　　sh2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
　　　　sh2.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
　　　　　　r.Offset(0, 2).Value
　　Next

　　With sh2.Range("C2", sh2.Range("C2").End(xlDown)).Offset(0, 1)
　　　　.Formula = "=IF(D1>=" & 規定数 - 不足分 & ",C2,D1+C2)"
　　　　.Value = .Value
　　End With
　
　　Application.DisplayAlerts = False
　　wsh.Delete
　　Application.DisplayAlerts = True
　
　　Application.ScreenUpdating = True

End Sub

Sub test1_1(tSh As Worksheet)
　　Dim e As Long
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　
　　With tSh
　　　　e = .Range("A1").CurrentRegion.Rows.Count
　　　　k = 1
　　　　For i = 2 To e
　　　　　　.Cells(i, 4) = k & .Cells(i, 2)
　　　　　　If Cells(i, 2) = .Cells(i + 1, 2) Then
　　　　　　　　j = j + 1
　　　　　　　　If j >= 規定数 And WorksheetFunction.CountIf( _
　　　　　　　　　　.Range(.Cells(i + 1, 2), .Cells(e, 2)), Cells(i, 2)) <= 余剰分 Then
　　　　　　　　　　　　.Cells(i, 4) = .Cells(i - 1, 4)
　　　　　　　　Else
　　　　　　　　　　If j >= 規定数 Then
　　　　　　　　　　　　k = k + 1
　　　　　　　　　　　　j = 0
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Else
　　　　　　　　If j >= 規定数 Then
　　　　　　　　　　.Cells(i, 4) = .Cells(i - 1, 4)
　　　　　　　　　　j = 0
　　　　　　　　End If
　　　　　　　　If .Cells(i, 2) = .Cells(i + 1, 2) Then
　　　　　　　　　　j = 0
　　　　　　　　Else
　　　　　　　　　　If j >= 規定数 - 不足分 - 1 And j < 規定数 Then
　　　　　　　　　　　　j = 0
　　　　　　　　　　Else
　　　　　　　　　　　　If j > 0 Then
　　　　　　　　　　　　　　j = j + 1
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End With
End Sub

・ツリー全体表示


	【77872】Re:オートフィルターの絞込列と抽出結果...

β - 16/1/16(土) 8:58 -


	引用なし

	パスワード

▼綾香さん：

データが膨大なので、オートフィルター処理より、フィルターオプション処理のほうが
早いかもしれません。

Sub Test2()
　　Dim shD As Worksheet
　　Dim shF As Worksheet
　　Dim r As Range
　　Dim dest As Long
　　Dim flg As Long
　　Dim sls As Long
　　
　　
　　Application.ScreenUpdating = False
　　
　　Set shD = Sheets("Data")
　　Set shF = Sheets("Filter")
　　
　　shF.UsedRange.ClearContents
　　
　　Set r = shD.UsedRange.Columns("A:RE")
　　shD.Range("RG2").Value = "ON"　　　　　　　　　　　　　　　 '検索条件
　　
　　dest = Columns("A").Column
　　sls = Columns("FL").Column
　　
　　For flg = Columns("NH").Column To Columns("RE").Column
　　　　shD.Range("RG1").Value = shD.Cells(1, flg).Value　　　　'検索項目
　　　　shF.Cells(1, dest).Resize(, 3).Value = Array(shD.Range("D1").Value, shD.Range("G1").Value, shD.Range("J1").Value)
　　　　shF.Cells(1, dest + 3).Value = shD.Cells(1, sls).Value
　　　　r.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　CriteriaRange:=shD.Range("RG1:RG2"), CopyToRange:=shF.Cells(1, dest).Resize(, 4), Unique:=False
　　　　　　
　　　　dest = dest + 5
　　　　sls = sls + 1
　　　　
　　Next
　　
　　shD.Range("RG1:RG2").Clear
　　shF.Select
　　
End Sub

・ツリー全体表示


	【77871】Re:規定数で区切るには

γ - 16/1/16(土) 8:44 -


	引用なし

	パスワード

▼karasu さん：
>　早速、本ファイルに組み込みたいと思います。

それもそうかもしれないが、まずはコードをよく理解する必要があるでしょう。

そして、追加質問する前に、ご自分で修正できるか検討する努力も
必要でしょう。
他人をコード制作機械かなにかのように考えていませんか？

# それにしてもどこかで聞いたような質問だなあ。
# 質問したまま放置しているわけだが、人として、気にならないのかなあ。

・ツリー全体表示


	【77870】Re:オートフィルターの絞込列と抽出結果...

β - 16/1/16(土) 8:35 -


	引用なし

	パスワード

▼綾香さん：

データが膨大なので、テストデータをつくるのもおっくうで、検証していません。
書きなぐっただけです。膨大な表なので、それなりに処理時間はかかると思います。

Sub Test()
　　Dim shD As Worksheet
　　Dim shF As Worksheet
　　Dim r As Range
　　
　　Dim dest As Long
　　Dim flg As Long
　　Dim sls As Long
　　
　　Application.ScreenUpdating = False
　　
　　Set shD = Sheets("Data")
　　Set shF = Sheets("Filter")
　　
　　shF.UsedRange.ClearContents
　　shD.AutoFilterMode = False
　　
　　shD.UsedRange.Columns("A:RE").AutoFilter
　　Set r = shD.AutoFilter.Range
　　
　　dest = Columns("A").Column
　　sls = Columns("FL").Column
　　
　　For flg = Columns("NH").Column To Columns("RE").Column
　　
　　　　r.AutoFilter field:=flg, Criteria1:="ON"
　　　　If r.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
　　　　　　r.Columns("D").Copy shF.Cells(1, dest)
　　　　　　r.Columns("G").Copy shF.Cells(1, dest + 1)
　　　　　　r.Columns("J").Copy shF.Cells(1, dest + 2)
　　　　　　r.Columns(sls).Copy shF.Cells(1, dest + 3)
　　　　End If
　　　　
　　　　shD.ShowAllData
　　　　dest = dest + 5
　　　　sls = sls + 1
　　　　
　　Next
　　
　　shD.AutoFilterMode = False
　　shF.Select
　　
End Sub

・ツリー全体表示


	【77869】Re:規定数で区切るには

karasu - 16/1/16(土) 3:38 -


	引用なし

	パスワード

βさん、ウッシさん、こんにちは。ご回答ありがとうございます。　早速、本ファイルに組み込みたいと思います。関連質問なのですが今回は規定値　50 不足分　 2 (規定値に足らなくても2以内なら次の項目ヘ) 余剰分　 2 (規定値オーバーでも2以内なら足す) で、以下のデータを処理したとき sheet1 no　　　種類　　　　数量 1　　　みかん　　　　148 2　　　りんご　　　　151 3　　　バナナ　　　　76 4　　　　桃　　　　　100 5　　　いちご　　　　34 sheet2 no　　　　種類　　　　数量　　　　 1　　　　みかん　　　　50　　　　50 1　　　　みかん　　　　50　　　　50 1　　　　みかん　　　　48　　　　48　<--　48で規定値50に満たないが不足分が 2　　　　りんご　　　　50　　　　50　　　　2以下なので次の「りんご」は 2　　　　りんご　　　　50　　　　50　　　　頭から50となる 2　　　　りんご　　　　51　　　　51　<--　規定値を超えているが余剰が 3　　　　バナナ　　　　50　　　　50　　　　2以下なので前ロットに入れる 3　　　　バナナ　　　　26　　　　26 4　　　　　桃　　　　　24　　　　50 4　　　　　桃　　　　　50　　　　50 4　　　　　桃　　　　　26　　　　26 5　　　　いちご　　　　24　　　　50 5　　　　いちご　　　　10　　　　10 上記の処理ができると大変助かります。不躾なお願いで申し訳ございませんが教えていただけませんか。宜しくお願い致します。

・ツリー全体表示


	【77868】オートフィルターの絞込列と抽出結果のコ...

綾香 - 16/1/16(土) 0:26 -


	引用なし

	パスワード

いつもお世話になっております。

Excelでオートフィルターの絞込列をずらしながら、
絞り込んだデータを別シートにコピペしたいのですが
どのようなVBAにすればいいか教えていただきたく投稿いたします。
お手数をおかけして恐縮ではございますが、お力をお貸しいただけますと幸いです。

やりたいことは以下の通りです。
------------------------------------------------------------------------------

「Data」というシートのA列～FK列に商品情報が、FL列～JI列に各月の販売データが、
NH列～RE列に販売データをもとに設定した”ON/OFF”情報が入力されています。
(例えばFL列のデータとNH列のFLGが対応)

この「Data」シートでオートフィルタ―を使い、
　1. NH列をON”で絞り込む操作をした後、
　2. D/G/J列(この3列は固定)とFLGに対応する販売データ(FL列)をコピーして
　3. 同ファイル内にある「Filter」シートのA1セルに張り付け、
　4.「Data」シートのフィルタを解除する
という処理を1まとまりとして、これをFLG列分繰り返したく思います。
（NH列の次はNI列でフィルタをかけ、D/G/J列とFM列をコピーして、
　「Filter」シートのG1セルに張り付け）

単純にフィルタをかけるVBAは下記で対応できたのですが、
絞込列とコピペ列をずらして繰り返し処理するにはどうしたらいいでしょうか。

Sub Sample()
　　With Sheets("Data").Range("NH1")
　　　　.AutoFilter Field:=1, Criteria1:="ON"
　　End With
End Sub

お手数をおかけして恐縮ではございますが、
重ねてお力添えのほど宜しくお願い致します。

【やりたいことのまとめ】
　・絞込条件列を1列ずつずらしてフィルタをかける
　・コピー列を1列ずつずらしてコピーする(ただし、D/G/J列は常にコピー対象)
　・貼付け済みのデータから1列空けた列に貼付けを行う

・ツリー全体表示


	【77867】Re:CSVの書き出しについて

ネオン - 16/1/15(金) 14:14 -


	引用なし

	パスワード

▼γ さん：
ご返信ありがとうございます。

なるほど、確かに単純に、事前に"を""に置換しておけば解決する話ですね…。
煮詰まって難しく考えすぎしまい、初歩的な点に気付けませんでした。お恥ずかしい限りです。

アドバイスいただきありがとうございました！

・ツリー全体表示


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

228 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free