Excel VBA質問箱 IV

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

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


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

229 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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 -


	引用なし

	パスワード

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

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

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

・ツリー全体表示


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

ウッシ - 16/1/15(金) 10:42 -


	引用なし

	パスワード

こんにちは

Sub test()
　　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
　　Const m　As Long = 3　　'規定数
　　
　　Set sh1 = Worksheets("Sheet1")
　　Set sh2 = Worksheets("Sheet2")
　　Set wsh = Worksheets.Add
　　
　　Application.ScreenUpdating = False
　　
　　sh2.UsedRange.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
　　
　　j = wsh.Range("A" & Rows.Count).End(xlUp).Row
　　With wsh.Range("D2:D" & j)
　　　　.Formula = "=B2&INT((ROW()+" & m - 2 & ")/" & m & ")"
　　　　.Value = .Value
　　End With
　　
　　
　　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=" & m & ",C2,D1+C2)"
　　　　.Value = .Value
　　End With
　　
　　Application.DisplayAlerts = False
　　wsh.Delete
　　Application.DisplayAlerts = True
　　
　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


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

β - 16/1/15(金) 10:12 -


	引用なし

	パスワード

▼karasu さん：

一例です。
勘違いあれば指摘願います。

Sub test()
　　DivItem 10
End Sub

Sub DivItem(cnt As Long)
　　Dim c As Range
　　Dim box As Long
　　Dim qtyIn As Long
　　Dim qtyBlc As Long
　　Dim qtySet As Long
　　Dim w As Variant
　　Dim dic As Object
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Cells
　　　　If c.Row <> 1 Then
　　　　　　qtyIn = c.EntireRow.Range("C1").Value
　　　　　　qtyBlc = qtyIn
　　　　　　Do
　　　　　　　　If cnt - box >= qtyBlc Then
　　　　　　　　　　qtySet = qtyBlc
　　　　　　　　Else
　　　　　　　　　　qtySet = cnt - box
　　　　　　　　End If
　　　　　　　　
　　　　　　　　qtyBlc = qtyBlc - qtySet
　　　　　　　　w = c.EntireRow.Range("A1:C1").Value
　　　　　　　　w(1, 3) = qtySet
　　　　　　　　dic(dic.Count) = w
　　　　　　　　
　　　　　　　　box = box + qtySet
　　　　　　　　If box = cnt Then box = 0
　　　　　　　　
　　　　　　Loop While qtyBlc > 0
　　　　End If
　　Next
　　　　
　　　　　　　　　　　　　　
　　With Sheets("Sheet2")
　　　　.UsedRange.ClearContents
　　　　.Range("A1:C1").Value = Sheets("Sheet1").Range("A1:C1").Value
　　　　.Range("A2").Resize(dic.Count, 3).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
　　　　With .Range("D2").Resize(dic.Count)
　　　　　　.Formula = "=IF(MOD(SUM(C$2:C2)," & cnt & "),MOD(SUM(C$2:C2)," & cnt & ")," & cnt & ")"
　　　　　　.Value = .Value
　　　　End With
　　　　.Select
　　End With
　　　　
End Sub

・ツリー全体表示


	【77864】規定数で区切るには

karasu - 16/1/15(金) 6:13 -


	引用なし

	パスワード

いつもお世話になります。 sheet1 　　　　規定数　10　<==任意の数　　A　　　 B　　　 C 1　No　　種類　　数量 2　 1　　みかん　　 4 3　 2　　りんご　　12 4　 3　　バナナ　　17 5　 4　　　桃　　　30 6　 5　　いちご　 13 sheet2 　　A　　　B　　　C　　　D 1　No　　種類　　数量 2　 1　　みかん　　4　　 4 3　 2　　りんご　　6　　10 4　 2　　りんご　　6　　 6 5　 3　　バナナ　　4　　10 6　 3　　バナナ　　10　　10 7　 3　　バナナ　　3　　 3 8　 4　　　桃　　　7　　10 9　 4　　　桃　　　10　　10 10　4　　　桃　　　10　　10 11　4　　　桃　　　3　　 3 12　5　　いちご　　 7　　10 13　5　　いちご　　6　　 6 sheet1の表からsheet2に表のように規定数の数になった時に次の種類のものの残りの数からまた規定数まで表示。また規定数を超える場合は規定数(今回は10)ごとに行を追加して残りを表示するようにしたいのです。どうぞ宜しくお願いいたします。

・ツリー全体表示


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

γ - 16/1/15(金) 4:06 -


	引用なし

	パスワード

今のコードでReplace関数を使って、"を""に置換すればいいんじゃないでしょうか。
ダブルクォーテーションの中のそれは、
二つで一つの意味となるので、
Replace(Cells(Row, col).Value, """", """""")
のような書き方になりますね。

タグ内と地の文章ではダブルクォーテーションの意味を区別するということなら
また別の工夫が必要になるけれど。

・ツリー全体表示


	【77862】CSVの書き出しについて

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


	引用なし

	パスワード

現在シート内のデータをCSVとして書き出すマクロを作成しております。

条件として、
・各項目は「""」で囲まず、カンマ区切り
・出力したいデータには<tr bgcolor="#000000">のようなHTMLが含まれているが、
　これは<tr bgcolor=""#000000"">としたい
といったものです。

Open Path For Output As #fileNo
　　For row = 1 To lastrow
　　　　For col = 1 To lastcol
　　　　　　Print #fileNo, Cells(row, col) & ",";
　　　　Next
　　　　Print #fileNo, Cells(row, col)
　　Next
Close #fileNo

上記の様にPrintを使って出力したのですが、
そうするとHTMLタグのダブルクォーテーションの部分も<tr bgcolor="#000000">のまま出力されてしまいます。

かといってWriteで出力すると、<tr bgcolor=""#000000"">にはなりますが、項目が「""」で囲まれてしまいます。

色々と調べているのですが、どうしても解決できずにおります。
どのようにすればよいか助言いただけますと幸いです。
よろしくお願いします。

・ツリー全体表示


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

229 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free