会社リストからHTMLファイルを作成しています。
1つの地域で1つのファイルにしています。
地域によっては会社数が多くなってきたので、
20社ごとにファイルを別にして出力したいと考えております。

tokyo
tokyo2
tokyo3
tokyo4
 ・
 ・
 ・

G列のファイル名を20社ごとに変換するには
以下のソースをどのように改良すれば良いのか、ご教授願います。

Sub HTMLファイル出力()
Dim myPath As String
Dim i As Long
myPath = Environ("USERPROFILE") & "\Desktop\Hoge\"
Range("A:G").Sort Key1:=Range("G2"), Header:=xlYes, MatchCase:=False, _
Orientation:=xlTopToBottom
For i = 2 To Range("G1").End(xlDown).Row
If Range("G" & i).Text <> Range("G" & i - 1).Text Then
Open myPath & Range("G" & i).Text & ".html" For Output As #1
Print #1, "<!DOCTYPE html>" & vbNewLine _
& "<html lang=""en"">" & vbNewLine _
& "<body>" & vbNewLine _
& "<div class=""span3"" id=""sidebar"">" & vbNewLine
End If
Print #1, "<div class=""widget"">" & vbNewLine _
& "<h4 class=""widgetTitle"">" & Range("A" & i).Text & "</h4>" & vbNewLine _
& "<ul><li>" & Range("B" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("C" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("D" & i).Text & "</li>" & vbNewLine _
& "<li>" & Range("E" & i).Text & "</li></ul></div>" & vbNewLine
If Range("G" & i).Text <> Range("G" & i + 1).Text Then
Print #1, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>"
Close #1
End If
Next
End Sub

「エクセルVBAでリストを仕分けしてファイ」の質問画像

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

A 回答 (2件)

現在のコードだと列Gの値で1社ずつの別ファイルで出力される。


これを20社で1ファイルとしたい。
で合ってます?

> If Range("G" & i).Text <> Range("G" & i - 1).Text Then

> If Range("G" & i).Text <> Range("G" & i + 1).Text Then
の行で会社が変ったことを判断しています。
なのでここに手を加える。

ここでカウンタを数え、20以内ならファイルオープン・クローズ操作しない。
20の倍数(カウンタ Mod20 =0)ならファイルオープン・クローズする。
ファイル名は”tokyo” & trim(カウンタを20で割った商(整数)+1)
クローズ時にはカウンタをリセットする。
Forループ終了時にカウンタの20の剰余を判断し、0でなければクローズ操作する。
(不要なのは会社数が20の倍数の時にループ内でクローズしてる場合)
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
当方、まったくの初心者なのです。
*カウンタを数え、20以内なら・・
*ファイルオープン・クローズ操作しない・・
*クローズ時にはカウンタをリセット・・
*Forループ終了時にカウンタの20の剰余を判断し・・
何をどうすればよいのか分からない状態です。
お手上げ状態です。

お礼日時:2014/10/12 17:49

HTML部分は自力で頑張って下さい。



カウンタはForループの添字[i]から1を引くことで求められます。
if の条件に
AND (i - 1)Mod 20 ) = 0
を加えて下さい。



小生、タブレットの手書き入力なので「全文書いて」にはお応えしかねまする。
    • good
    • 0
この回答へのお礼

ありがとうございます。
早速チャレンジしてみます。

お礼日時:2014/10/12 23:13

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

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

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

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

Qエクセル プルダウンの作り方

お世話になります。
エクセルでプルダウンの作り方を教えていただけませんでしょうか?
住所を▼のボタンでクリックしたら【北海道,青森,秋田,岩手・・・】などの選択ができるようにしたいのです。
宜しくお願いします。

Aベストアンサー

メニューから「データ」、「入力規則」、「設定」で「入力値の種類」を「リスト」を選択します。
そうすると「元の値」という表示がでますので、そこで前もって作っておいたリストの範囲を指定します。
多くないのでしたら、そのままそこにカンマで区切って入力しても出来ます。

QエクセルVBAでテキストファイル(バッチファイルの作成)

エクセルVBA超初心者です。
言語は基本的にC言語しか知りません。

エクセルVBAでボタンを実行したら
たとえば以下のような内容のバッチファイルが
デスクトップに出来る・・・
というものを作らなくてはいけなくなりました。
色々調べてるのですが、ファイル入出力関連の記述の仕方がまったくわからず、あまり時間がなく困っています。

ちなみにバッチファイルの内容は



REM サーバー上からプログラムフォルダをダウンロードする。
XCOPY \\hk001a24\va\data\ツール配信用\セグメント D:\セグメント /I/Y/F/E
REM フォルダへ移動する。
D:
CD D:\セグメント
REM ショートカットをデスクトップに作成する。
csc.exe "D:\セグメント\入力シート.xls" "?desktop?\セグメント入力シート.lnk"
csc.exe "D:\セグメント\出力シート.xls" "?desktop?\セグメント出力シート.lnk"
csc.exe "D:\セグメント\出力帳票" "?desktop?\セグメント出力帳票.lnk"
exit


ここまで。。。
これをボタン実行後、
test.batというファイルに作成しデスクトップに保存する。

似たようなロジックや参考になるURLがあったら教えてください。
長々とすみません、よろしくお願いいたします。

エクセルVBA超初心者です。
言語は基本的にC言語しか知りません。

エクセルVBAでボタンを実行したら
たとえば以下のような内容のバッチファイルが
デスクトップに出来る・・・
というものを作らなくてはいけなくなりました。
色々調べてるのですが、ファイル入出力関連の記述の仕方がまったくわからず、あまり時間がなく困っています。

ちなみにバッチファイルの内容は



REM サーバー上からプログラムフォルダをダウンロードする。
XCOPY \\hk001a24\va\data\ツール配信用\セグメント D:\セグ...続きを読む

Aベストアンサー

Sub MakeBat()
Dim n As Long
Dim DesktopPath As String

n = FreeFile

DesktopPath = CreateObject("WScript.Shell").SpecialFolders("desktop")

Open DesktopPath & "\Test.bat" For Output As #n
Print #n, "Rem サーバー上からプログラムフォルダをダウンロードする。"
Print #n, "XCOPY \\hk001a24\va\data\ツール配信用\セグメント D:\セグメント /I/Y/F/E"
Print #n, "Rem フォルダへ移動する。"
Print #n, "D:"
Print #n, "CD D:\セグメント"
Print #n, "Rem ショートカットをデスクトップに作成する。"
Print #n, "csc.exe ""D:\セグメント\入力シート.xls""; ""?desktop?\セグメント入力シート.lnk"""
Print #n, "csc.exe ""D:\セグメント\出力シート.xls"" ""?desktop?\セグメント出力シート.lnk"""
Print #n, "csc.exe ""D:\セグメント\出力帳票"" ""?desktop?\セグメント出力帳票.lnk"""
Print #n, "exit"
Close #n
End Sub

Sub MakeBat()
Dim n As Long
Dim DesktopPath As String

n = FreeFile

DesktopPath = CreateObject("WScript.Shell").SpecialFolders("desktop")

Open DesktopPath & "\Test.bat" For Output As #n
Print #n, "Rem サーバー上からプログラムフォルダをダウンロードする。"
Print #n, "XCOPY \\hk001a24\va\data\ツール配信用\セグメント D:\セグメント /I/Y/F/E"
Print #n, "Rem フォルダへ移動する。"
Print #n, "D:"
Pri...続きを読む

Qエクセルでプルダウンメニューの作り方

  エクセルの画面で、よく三角形を逆さまにした形をクリックするといくつかメニューが出てき、どれかを選べるようになっていますが、その作り方を教えてください。
 会社で人事を担当していますが、三角形(プルダウンボタン)をクリックすると社員氏名一覧が表示され、そこから選択できるようにしたいのです。
 しばらく自力でいろいろやってみましたが、さっぱり見当がつかず、どうやればいいのか分かりませんでした。よろしくお願いします。

Aベストアンサー

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならないでしょうか?
Excel2007の場合は↓のURLが参考になるかもしれません。

http://www.eurus.dti.ne.jp/~yoneyama/Excel2007/excel2007-ny_kis2.html

尚、同一Sheetに「名簿表」を作成する場合は名前定義する必要はなくて
「元の値」の右側の四角をクリックし、リスト表示したいセルをそのまま範囲指定すればOKです。

以上、お役に立てば良いのですが・・・m(_ _)m

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならない...続きを読む

QVBAで作成した配列をエクセルに出力する方法

どなたかご教授ください。
一方のエクセル(test_report_kw.xlsm)の中にあるテキストから
もう一方のエクセル(test_search_kw.xlsx)に指定する文字があるかを確認し
その結果をエクセルに吐き出すプログラムを作成しています。

その際、文字検索結果(含まれる場合:1、含まれない場合:0)を作成した
配列flgを作成し、エクセルに吐き出すようにしているのですが
吐き出した結果が全て0出力になっており困っております。

ウォッチ式で確認する限り、配列内では正常に処理されており
出力段階に何か問題があるようです。

どなたかご教授くださいますと幸いです。

Dim report_kw() As Variant
Dim search_kw() As Variant
Dim flg() As Integer

Workbooks("test_report_kw.xlsm").Worksheets("report_sum").Activate
LastCell_Row_Report_kw = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

ReDim report_kw(LastCell_Row_Report_kw, 1)
report_kw = Range(Cells(2, 1), Cells(LastCell_Row_Report_kw, 1))

Workbooks("test_search_kw.xlsx").Worksheets("Sheet1").Activate
LastCell_Row_search_kw = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

ReDim search_kw(LastCell_Row_search_kw, 1)
ReDim flg(LastCell_Row_Report_kw - 1)

search_kw = Range(Cells(2, 2), Cells(LastCell_Row_search_kw, 2))

For i = 1 To LastCell_Row_Report_kw - 1

'初期化
flg(i) = 0

For l = 1 To LastCell_Row_search_kw - 1

If InStr(report_kw(i, 1), search_kw(l, 1)) > 0 Then flg(i) = flg(i) + 1

Next
Next

Workbooks("test_report_kw.xlsm").Worksheets("report_sum").Activate

Range("e1").Value = "FLG"
Range("e2").Resize(LastCell_Row_Report_kw - 1, 1).Value = flg

どなたかご教授ください。
一方のエクセル(test_report_kw.xlsm)の中にあるテキストから
もう一方のエクセル(test_search_kw.xlsx)に指定する文字があるかを確認し
その結果をエクセルに吐き出すプログラムを作成しています。

その際、文字検索結果(含まれる場合:1、含まれない場合:0)を作成した
配列flgを作成し、エクセルに吐き出すようにしているのですが
吐き出した結果が全て0出力になっており困っております。

ウォッチ式で確認する限り、配列内では正常に処理されており
出力段階に何か問題があるよう...続きを読む

Aベストアンサー

1次元配列を縦に出力しているからです。

横に出力すれば正しく表示されます。
例えば、
Range("e2").Resize(1, UBound(flg) + 1).Value = flg
のように。

どうしても縦に出力したいのであれば、2次元配列にしましょう。

Qエクセル(Excel) 納品書の作り方【画像修正版

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が見にくかったのでシート<CENTER></CENTER>だけにしました。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルでコピー!
そのまま最後の24行目までコピーしておきます。

F4セルには
=IF(COUNTBLANK(B4:E4),"",D4*E4)
という数式を入れ、F24までオートフィルでコピー!

これでB列に商品番号を入力すればSheet2のデータが反映され、
E列に数量を入力でF列に金額が表示されると思います。

最後に合計金額のF26セルは
=IF(COUNT(F4:F24),SUM(F4:F24),"")
手数料のF27セルは
=IF(F26="","",F26*0.2)

これで何とか形にならないでしょうか?

※ 振込金額の欄は不明ですので手を付けていません。

参考になりますかね?m(_ _)m

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルで...続きを読む

Qvbaマクロにて 複数のエクセルファイルデータを1つのファイルにまとめる作業

vbaマクロにて初心者なので教えてください。
各店舗から送られてくる注文表を本店でまとめるため、
複数のエクセルファイルデータを1つのファイルにまとめる作業を行いたいと考えております。

本店ファイルのA列1セルはプルダウン形式で支店名が選択できるようにしているので、
支店名を選択し、マクロボタンを押せば、選択した支店名の注文内容が一発で値貼付できるようにしたいのです。
具体的には、作業実行中「本店ファイル」のA列1セルに入力されている「支店名ファイル」のシート1B列1~C列10までのデータを、「本店ファイル」のシート1B列1~C列10に値でコピーして貼り付けするという作業を行いたいです。両ファイルは同じフォルダ内にあります。

ご教授の程よろしくお願いいたします。

Aベストアンサー

以下のようにしてください。
--------------------------------------
Public Sub Macro1()
Dim Thisbook_path As String
Dim Excel_path As String
Dim Excel_name As String
'実行中のマクロが記述されているブックのフォルダへの絶対パス
Thisbook_path = ThisWorkbook.Path
MsgBox (Thisbook_path)
Excel_path = Thisbook_path & "\" & Worksheets("Sheet1").Cells(1, 1).Value & ".xlsx"
Excel_name = Worksheets("Sheet1").Cells(1, 1).Value & ".xlsx"
MsgBox (Excel_path)
MsgBox (Excel_name)
If Dir(Excel_path) = "" Then
MsgBox (Excel_path & "が存在しません")
Exit Sub
End If
Workbooks.Open Excel_path
ThisWorkbook.Activate
Workbooks(Excel_name).Worksheets("Sheet1").Range("B1:C10").Copy Destination:=Worksheets("Sheet1").Range("B1:C10")
Workbooks(Excel_name).Close
End Sub
---------------------------------------
ファイルをオープンする場合、絶対パス名でオープンします。
拡張子はxlsxにしてあります。(xlsmでは有りません。念の為)
シート名はShee1にしてあります。(適宜、あなたの環境に変更してください)
途中経過を表示の為に、メッセージボックスにデータを表示しています。不要ならコメントアウトしてください。

以下のようにしてください。
--------------------------------------
Public Sub Macro1()
Dim Thisbook_path As String
Dim Excel_path As String
Dim Excel_name As String
'実行中のマクロが記述されているブックのフォルダへの絶対パス
Thisbook_path = ThisWorkbook.Path
MsgBox (Thisbook_path)
Excel_path = Thisbook_path & "\" & Worksheets("Sheet1").Cells(1, 1).Value & ".xlsx"
Excel_name = Worksheets("Sheet1").Cells(1, 1).Value & ".xlsx"
MsgBox (Excel_...続きを読む

Qエクセル(Excel) 納品書の作り方【改めて】

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が貼り付けてあります。商品名は1番以外伏せさせていただいています。
くっつけてありますが、左側がシート1・右側がシート2です。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

画像がいまいちよく見えないのですが、納品書の項目は左から、No、商品番号、商品名、単価、数量、金額でいいのでしょうか(名前は多少違っていても意味があっていればもんだいないです)

でしたら、
C1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,2,FALSE))
D1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,3,FALSE))
E1セルは空白で
F1セルに=IF(D2="","",D2*E2)
といれて、C1からF1までをコピーしてその下の行にタテに貼り付ければ出来ますよ。
おそらくエラーが出たのは、コピーしたときにVLOOKUP関数の最初のセルの指定がずれてしまっているのでは無いかと思いますよ。     

Qエクセルvbaで特定フォルダに3つのcsvファイルがあり、それを読み込んで一つのブック内に3つのワー

エクセルvbaで特定フォルダに3つのcsvファイルがあり、それを読み込んで一つのブック内に3つのワークシートとしたいです。 簡単そうで、難しいです。ネットのサンプルプログラムもあまり参考になりませんでした。vbaは初心者です

Aベストアンサー

スマホなんでコードは無理ですが。

csv読み込むたびにシート作成したらいいんじゃないの?

とりあえず、処理の順序を日本語で置き換えることは出来ますか?

Qエクセル2007でプルダウンで選んだものに反応

Excel2007でプルダウンで選んだものに反応して隣のセルが自動入力される方法(エクセル2007)
A1をプルダウンで「猫」「犬」から選べるようにし、「猫」を選んだ場合B1に自動に「111」が、「犬」を選んだ場合B1に自動に「222」と入力されるようにしたいです。
ご教授の程、宜しくお願いします。

Aベストアンサー

VLOOKUP関数での方法です。
(1)別シートに入力文字列と対応コード表を作成。(仮にSheet2のA:B列範囲で順不同)
(2)B1に=IF(COUNTIF(Sheet2!A:A,A1),VLOOKUP(A1,Sheet2!A:B,2FALSE),"")を設定
   入力文字列が存在しない場合は空白としています。

Qエクセル(VBA)でファイル出力時

エクセル(VBA)でテキストファイル出力時
リターンコードはどうやって記述するのでしょうか?

chr(9)はタブ
chr(10)はラインフィード
chr(13)はキャリッジリターン

らしいんですがリターンコードはなんでしょうか?

宜しくお願いします

Aベストアンサー

こんにちは。maruru01です。
Enterキーの入力であれば、Chr(13)です。
ちなみに、Windowsでの改行は、VBやVBAでは
Chr(10) & Chr(13)で表します。
これはvbCrLfという定数が用意されており、例えば、
"1行目" & vbCrLf & "2行目"
のように記述します。もちろんこれは、
"1行目" & Chr(10) & Chr(13) & "2行目"
とまったく同じことです。
それから、VBAの画面でHELPで、"ascii"と入れて検索すると、文字コード表が見られますよ。
では。


人気Q&Aランキング