Office2003のエクセルでVBAを勉強しております。

そこで、VBAで別エクセルファイルからあるシートを指定エクセルファイルへ丸まるコピーしたい場合にはどのようにすればよいのでしょうか?

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

A 回答 (1件)

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)




>Office2003のエクセルでVBAを勉強しております。

方法が解らなければ、記録マクロを確認するのが一番です。
動作が理解出来たら、コードの最適化を行ってください。

この回答への補足

補足です。
>方法が解らなければ、記録マクロを確認するのが一番です。
>動作が理解出来たら、コードの最適化を行ってください。

を行い
  Workbooks.Open Filename:="test_1.xls"
Windows("test_1.xls").Activate
Sheets("Sheet1").Cells.Select
Selection.Copy
Windows(strNewFileName).Activate
Sheets("Sheet1").Cells.Select
ActiveSheet.Paste
する事で一応できました。
後は最適化を行いたいと思います。
有難うございました。

補足日時:2007/04/17 13:56
    • good
    • 2
この回答へのお礼

早速のアドバイス有難うございます。

Sheets("A").Copy Before:=Workbooks("Book1").Sheets(1)
を試しました。

実際には下記のように書いてテストしました。
結果は「インデックスが有効範囲にありません」とエラーとなってしまいました。
Private Sub btnCombine_Click()
Dim result As Boolean
result = makeNewExcelFile()

Workbooks.Open Filename:=lblPath_1.Caption
Worksheets("Sheet1").Copy After:=Workbooks(strNewFileName).Worksheets("Sheet3")

End Sub

'新規エクセルファイルを作成
Function makeNewExcelFile() As Boolean
Dim intSheetCnt As Integer
'これで新規ブックでのシート数を1にします
Application.SheetsInNewWorkbook = 1
Workbooks.Add
strNewFilePath = "C:\"
strNewFileName = Format(Date, "yyyymmdd") & ".xls"
ActiveWorkbook.SaveAs strNewFilePath & strNewFileName
ActiveWorkbook.Close
End Function


コピー元エクセルファイルとコピー先エクセルファイルの指定の仕方がよくわかりませんでした。

お礼日時:2007/04/17 12:38

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

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

このQ&Aを見た人はこんなQ&Aも見ています

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

Q圧縮したファイルと圧縮していないファイルについて

圧縮したファイルと圧縮していないファイルについて質問です。
1.圧縮したファイルと圧縮していないファイルでは、どちらが壊れやすいですか?
2.壊れたかどうか、チェックしやすいのはどちらですか?
3.壊れたファイルを修復しやすいのはどちらですか?
4.バックアップするなら、どちらがお勧めですか?
5.総合的に圧縮するべきだと思いますか?
これから保存する際に圧縮すべきか迷っています。みなさんのお力添えの程、よろしくお願いいたします。
ちなみに、画像ファイルや動画ファイルを保存しています。OSはWindows7です。
圧縮したファイルと圧縮していないファイルの両方で、データが壊れた経験があります。
(圧縮していないファイルでは、画像の下半分が灰色になったり、ファイルが開けなくなったりです。)
(圧縮したファイルでは、crcが違います。ファイルは壊れています。と解凍する際にメッセージが出ました。解凍したファイルはやはり壊れていました。)

Aベストアンサー

圧縮ファイル=ZIPやRAR、LZHなどの可逆圧縮と解釈して
回答します。
ちなみに画像や動画ファイルはそもそも圧縮されています。
そのためZIPなどに圧縮してもファイルサイズは小さくなりません。

1. 画像、動画ファイルなら同じです。
  圧縮してサイズが半分になれば壊れる確率も約半分と
  思います。クラスタサイズとファイルサイズにもよりますが

2. チェック?アプリで開けるかどうかで判断する?
  それであれば圧縮しているファイルの方が一手間多いですね。

3. 壊れたら修復できないと思います。

4. 無圧縮ファイル。動画や画像ファイルを圧縮しても効果が
  小さく処理時間や電気代がもったいないので。

5. 総合的に圧縮?OSの機能でのフォルダごとに圧縮という
  意味であればすべきではありません。
  4と同じで効果が少ないからです。

主さんの対象にしているファイルでは圧縮処理は必要ありません。
Office系のファイルであれば効果があると思います。

余談ですがファイルシステムの仕様上小さなサイズのファイル
(1KBなど)がたくさんある場合ZIPファイルなどで複数ファイルを
1ファイルにまとめると効果が期待できます。

HDDがタイ洪水の影響で少々高価な状況ですが手間に比べたら
安いものなので足りなくなったら買い足した方がいいと思います。

圧縮ファイル=ZIPやRAR、LZHなどの可逆圧縮と解釈して
回答します。
ちなみに画像や動画ファイルはそもそも圧縮されています。
そのためZIPなどに圧縮してもファイルサイズは小さくなりません。

1. 画像、動画ファイルなら同じです。
  圧縮してサイズが半分になれば壊れる確率も約半分と
  思います。クラスタサイズとファイルサイズにもよりますが

2. チェック?アプリで開けるかどうかで判断する?
  それであれば圧縮しているファイルの方が一手間多いですね。

3. 壊れたら修復できない...続きを読む

QエクセルVBAでボタンを作ったシートとVBAを実行するシートを変えたい

シート1にボタンを作成し、
そのボタンを押すと実行するVBAを作成しました。
そこで、VBAを実行するシートの指定はできるのでしょうか。
例えば、ボタンを押すと、
10行から20行まではシート2で実行させ、
30行から40行まではシート3で実行させたいと考えています。
可能でしょうか。
どうぞ宜しくお願いします。


***********************************************
作成したVBA。ボタンはシート1にあります。
***********************************************

Private Sub CommandButton1_Click()


***********************************************
ここからはシート2で実行させたい
***********************************************
Range("E2").Select
ActiveCell.FormulaR1C1 = "10"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E101"), Type:=xlFillDefault
Range("E2:E101").Select


***********************************************
ここからはシート3で実行させたい
***********************************************
Range("A2").Select
ActiveCell.FormulaR1C1 = "100"
Range("A2").Select
Selection.AutoFill Destination:=Range("E2:E101"), Type:=xlFillDefault
Range("A2:A101").Select

End Sub

シート1にボタンを作成し、
そのボタンを押すと実行するVBAを作成しました。
そこで、VBAを実行するシートの指定はできるのでしょうか。
例えば、ボタンを押すと、
10行から20行まではシート2で実行させ、
30行から40行まではシート3で実行させたいと考えています。
可能でしょうか。
どうぞ宜しくお願いします。


***********************************************
作成したVBA。ボタンはシート1にあります。
***********************************************

Private Sub CommandB...続きを読む

Aベストアンサー

予期しないエラーを避けるため
シートを直接選択したらどうでしょうか

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

***********************************************
ここからはシート2で実行させたい
***********************************************
Sheets("Sheet2").Select

Range("E2").Select
ActiveCell.FormulaR1C1 = "10"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E101"), Type:=xlFillDefault
Range("E2:E101").Select


***********************************************
ここからはシート3で実行させたい
***********************************************

Sheets("Sheet3").Select

Range("A2").Select
ActiveCell.FormulaR1C1 = "100"
Range("A2").Select
Selection.AutoFill Destination:=Range("E2:E101"), Type:=xlFillDefault
Range("A2:A101").Select

Sheets("Sheet1").Select
Application.ScreenUpdating = True

End Sub

予期しないエラーを避けるため
シートを直接選択したらどうでしょうか

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

***********************************************
ここからはシート2で実行させたい
***********************************************
Sheets("Sheet2").Select

Range("E2").Select
ActiveCell.FormulaR1C1 = "10"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E101"), Type:=xlFillDefault
Range("E2:E101").Selec...続きを読む

QLhaplusで圧縮したファイルについて

メールで送るファイルをLhaplusで圧縮した時、
デスクトップに圧縮前のファイルと圧縮後のファイルがふたつできることに
なりますが、圧縮後のファイルは捨てていますか?
圧縮ファイル作る度に倍になっていきますよね。。。

Aベストアンサー

メールに添付するために圧縮したのであれば、
圧縮後のファイルは削除すればよいと思います。
再度送る必要が出来た場合、再度圧縮すればよいので。

Qエクセル VBA 別エクセルファイルを参照

A1111
B1111
N1243
F2144

のように一定のデータを連続して入力された
エクセルファイルと
別のエクセルファイルで一致するデータを探す
マクロを作っています

別のエクセルファイルを参照するよい方法が
分かりません、どなたか教えてください。

Aベストアンサー

こんばんわ。

照合したいデータがセルA2~A5にあり、別ファイル「test.xls」のシート「Sheet1」のセル「A2:A101」に照合されるデータがあるものとして、下にサンプルコードを載せました。
なお、このコードを実行する際、別ファイルのブックを開いておく必要があります。

Sub test()
  Dim sf As String, ss As String, sr1 As String, s As String
  Dim ra1 As Range, ra2 As Range, i As Integer, l As Long
  sf = "test.xls" '別ファイル名
  ss = "Sheet1" '別ファイルのシート名
  sr1 = "A2:A101" '別ファイルのシートのデータがあるセル範囲
  For i = 2 To 5
    Set ra1 = Workbooks(sf).Worksheets(ss).Range(sr1)
    Set ra2 = Range("A" & i) '照合データがあるセル
    If Application.WorksheetFunction.CountIf(ra1, ra2) > 0 Then
      l = Application.WorksheetFunction.Match(ra2, ra1, 0) + 1
      s = "別ファイルの一致するデータのセル位置は「A" & l & "」です"
    Else
      s = "別ファイルに一致するデータはありません"
    End If
    MsgBox s
  Next i
End Sub

こんばんわ。

照合したいデータがセルA2~A5にあり、別ファイル「test.xls」のシート「Sheet1」のセル「A2:A101」に照合されるデータがあるものとして、下にサンプルコードを載せました。
なお、このコードを実行する際、別ファイルのブックを開いておく必要があります。

Sub test()
  Dim sf As String, ss As String, sr1 As String, s As String
  Dim ra1 As Range, ra2 As Range, i As Integer, l As Long
  sf = "test.xls" '別ファイル名
  ss = "Sheet1" '別ファイルのシート名
  s...続きを読む

Qファイルの圧縮形式は何がいいですか?

ファイルの圧縮形式は何がいいですか?

PCが思いので、ファイルを整理しようと思うのですが、ファイルの圧縮は何にすれば、いちばん軽く、使いやすいですか?とりあえず、動画ファイルと音楽ファイルを圧縮したいのですが。
圧縮率が高く、それでいて使いたいときにいちいち解凍しなくてもよい圧縮形式を教えてください。

Aベストアンサー

PCが重いのとファイルの圧縮は関係ないですが。

圧縮形式でいえば、
lzhは問題があってもう使われなくなりますし、
7z形式はいろいろ機能的にはいいのですが、
無難なところではZipをお勧めします。

Q【excel vba】エクセルファイル内にある数式の内「関数名(IF,SUM等)」のみを、同ファイル内の新しいシートに一覧化したいです。

vba初心者です。(ネットからコードを拾ってきてちょっと改造できる程度)
excel 2003を使用しています。

【前提】
・「数式」「数値」「文字列」等がセルに入力されたエクセルファイルを使用する
 ⇒「関数名」のみを表示する。(文字列や数値が入力されたセルは無視)
・「数式」セルには「関数」が使われているものと、そうでないものがある
・1セル内に複数の関数が使用されている場合あり(新出の関数名であればすべて抽出したい)
・検索対象シート:ブック内のすべてのシート


【質問】
findメソッドで「IF」や「SUM」というように直接関数名を指定して検索するのではなく、「関数」というククリで検索はできるのでしょうか?

その検索結果を同ファイル内に新しいシート(Sheet1)を作成し、「関数名」を一覧表示するという流れ(以下にまとめました)にしたいです。

【手順】
(1)Book1内で「関数」検索をする
(2)「関数」が見つかった場合は「Sheet1」シートを作成(関数が見つからない場合は,msgbox "該当なし")
(3)検索した「関数名」をSheet1のA1セルに入力する
(4)Book1内すべて(複数シート有り)の関数名を抽出するまで連続検索をする
 ⇒A1→A2→A3→…の様に、A列の上から順に入力していく
※関数名の重複がないように一覧化できれば最高です。
※シート毎に、抽出した関数名を分けなくて大丈夫です。(あくまでファイル全体で使用されている関数名の一覧)
(5)msgbox "終了"


解決方法をご存知の方、ご教示願えませんでしょうか。

宜しくお願いいたします。

vba初心者です。(ネットからコードを拾ってきてちょっと改造できる程度)
excel 2003を使用しています。

【前提】
・「数式」「数値」「文字列」等がセルに入力されたエクセルファイルを使用する
 ⇒「関数名」のみを表示する。(文字列や数値が入力されたセルは無視)
・「数式」セルには「関数」が使われているものと、そうでないものがある
・1セル内に複数の関数が使用されている場合あり(新出の関数名であればすべて抽出したい)
・検索対象シート:ブック内のすべてのシート


【質問】
findメソ...続きを読む

Aベストアンサー

#1 です。

なんか質問の形式をとった作成依頼っぽい気がしなくもない。一応
突っ込み入れときます。

こんな感じでできる気がする。適当に参照設定をして試してみて下さい。
ユーザー定義関数(日本語名を含む)があっても大丈夫かと。

余談:

vArray = Range("A1:C1").Formula

で Value 同様数式の2次元配列が得られますから、速度面が問題になる
ようなら配列処理に改造してみて。


Sub sample()

  Dim dic     As Dictionary
  Dim reg     As RegExp
  Dim regMatch  As Match
  Dim s      As String
  Dim rHasFormula As Range
  Dim r      As Range
  Dim sh     As Worksheet
    
  Set reg = New RegExp
  Set dic = New Dictionary
  
  reg.Global = True
  reg.Pattern = "([^!-@\[\]]+)"

  For Each sh In ActiveWorkbook.Worksheets
  Do
    On Error Resume Next
    ' 23: xlErrors or xlLogical or xlNumbers or xlTextValues
    Set rHasFormula = sh.Cells. _
             SpecialCells(xlCellTypeFormulas, 23)
    On Error GoTo 0
    If rHasFormula Is Nothing Then Exit Do
    
    For Each r In rHasFormula.Cells
      ' // 数式のセル参照文字をR1C1相対参照に固定する
      s = Application.ConvertFormula(r.Formula, _
                      xlA1, _
                      xlR1C1, _
                      xlRelative)
      For Each regMatch In reg.Execute(s)
        Select Case UCase$(regMatch.Value)
        ' // セル参照文字やブール値を除外
        Case "R", "C", "RC", "TRUE", "FALSE"
        Case Else
          ' // Dictionary でカウントしつつ重複のないリストにする
           dic(regMatch.Value) = dic(regMatch.Value) + 1
        End Select
      Next
    Next
    
    Exit Do
  Loop
  Next sh
  
  ' // 出力(面倒なので適当)
  With ThisWorkbook.Worksheets("Result")
    .Activate
    .Cells.Delete
    With .Range("A1:B1")
      .Font.Bold = True
      .Value = Array("Function", "Count")
    End With
    .Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.Keys)
    .Range("B2").Resize(dic.Count).Value = Application.Transpose(dic.Items)
    .Columns("A:B").AutoFit
  End With

  Set reg = Nothing
  Set dic = Nothing
  
End Sub

#1 です。

なんか質問の形式をとった作成依頼っぽい気がしなくもない。一応
突っ込み入れときます。

こんな感じでできる気がする。適当に参照設定をして試してみて下さい。
ユーザー定義関数(日本語名を含む)があっても大丈夫かと。

余談:

vArray = Range("A1:C1").Formula

で Value 同様数式の2次元配列が得られますから、速度面が問題になる
ようなら配列処理に改造してみて。


Sub sample()

  Dim dic     As Dictionary
  Dim reg     As RegExp
  Dim regMatch...続きを読む

Qjarファイルはzipファイルと同じだというけれど、無圧縮ですか?

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

jarファイルについてなのですが、
いろいろ調べてみたところ、
「jarファイルはzipファイルの拡張子を『.jar』に変えたもの」
という説明が随所に見られます。

しかし、zip圧縮にも、通常?圧縮だったり、無圧縮だったり、といろいろな圧縮方法があると思うのですが、
「jarファイルは、無圧縮zipファイルの拡張子を『.jar』に変えたもの」

というのが正しい解釈なのでしょうか?
jarファイルを解凍して、その後、通常zip圧縮をしたら、元のファイルよりもファイルサイズが小さくなってしまったので、無圧縮なのかな・・と思い、質問させていただきました。

ご存知の方、よろしくお願いいたします。

Aベストアンサー

試しにjar.exeを使ってみましたが若干圧縮されていました。
zipは圧縮の際、圧縮率を指定できます。(確かzlibで10段階)
圧縮率を上げれば、ファイルサイズは小さくなりますが
その代わりエンコード、デコードに時間がかかるようになります。
jar作成のものは展開速度を上げる等の理由で圧縮率が
低く設定されているのではないでしょうか?

Qエクセルで指定した行範囲を別のシートにコピーするには?

(1)指定した行(数値)を変数として登録する方法
tx1 = Sheets("0").Range("A1")
tx2 = Sheets("0").Range("A2")
tx3 = Sheets("0").Range("A3")

A1=2
A2=2000
A3=2500

(2)(1)で指定した変数を使用して行範囲を他のシートSheets(”1”)、Sheets("2”)にコピーペースト。


行(”2:1999”) ←tx1 : tx2-1(A2の数値から1を引いた数値)

Rows(▲▲▲▲▲▲).Select
Selection.Copy
Sheets("1").Select
Rows("1:1").Select
ActiveSheet.Paste

行(”2000:2499”) ←tx2 : tx3-1(A3の数値から1を引いた数値)

Range(▲▲▲▲▲▲).Select
Selection.Copy
Sheets("2").Select
Rows("1:1").Select
ActiveSheet.Paste

▲部分がエラーになってしまい、うまくいきません。
正しい方法を教えてください。

(1)指定した行(数値)を変数として登録する方法
tx1 = Sheets("0").Range("A1")
tx2 = Sheets("0").Range("A2")
tx3 = Sheets("0").Range("A3")

A1=2
A2=2000
A3=2500

(2)(1)で指定した変数を使用して行範囲を他のシートSheets(”1”)、Sheets("2”)にコピーペースト。


行(”2:1999”) ←tx1 : tx2-1(A2の数値から1を引いた数値)

Rows(▲▲▲▲▲▲).Select
Selection.Copy
Sheets("1").Select
Rows("1:1").Select
ActiveSheet.Paste

行(”2000:2499”) ←tx2 : tx3-1(A3の数値から1を...続きを読む

Aベストアンサー

最初のエラーのところですが、以下で大丈夫だとおもいます。
Rows(tx1 & ":" & tx2 - 1).Copy Destination:=Sheets("1").Rows("1:1")

Q大容量のファイルを圧縮出来る圧縮形式トについて

大容量のファイルを圧縮できる形式(ソフト)を探しています。
ファイルの容量は約15GBくらいです。

これくらいのファイル容量を圧縮できる
圧縮形式をご存知の方

この圧縮形式だと圧縮できるファイルサイズは
MAX○○GBまでみたいな情報を表示しているサイトをご存知の方

教えていただけないでしょうか?

圧縮できる最大容量という情報は意外に少なくて困っています


ちなみに現在ファイルの分割は想定していません。

Aベストアンサー

7zipなんていう圧縮形式があります。
アプリケーションはオープンソースで現在開発が進んでますが、使用にはあまり差し支えないレベルまできてます。(現在ver4.23)

フォーマットの仕様書(http://www.7-zip.org/7z.html)を見ると、結構大容量までサポートしているようですが、実際にこんなに大きなサイズのファイルを扱えるかどうかは試したことないです。
(というかこのサイズだと、フォーマットの限界以前にファイルシステムの制限が来る)

過去にSQL Serverのバックアップファイルをネットワーク越しに送信するためにこのソフト使って圧縮しましたが、そのときのファイルサイズは2~3GB程度でした。15GBが実際に扱えるかどうかは試してみないと何とも言えないです。

なお、提示したURLはすべて英語ですが、7zipのアプリケーション自体は日本語のメニューにすることが可能です。

参考URL:http://www.7-zip.org/

Qエクセル2003 VBAでフォルダ内にファイル格納

作成してあるフォルダの中にテキストファイル(html)を格納する事は可能でしょうか。

フォルダはすでに作成してあります。
デスクトップ>zenkoku>kanagawa>kanagawa01>kanagawa01A

ファイル名はすべて index.html  

(1)「kanagawa02」フォルダには 会社名と住所とF列の値(20社分)
  →20社ごとに01、02、03 となっています。

(2)「kanagawa02A」フォルダには 会社名と住所と電話番号(1社分のみ)


※以下は 会社と住所のHTMLファイル((1)の例)です。

<!DOCTYPE html>
<html lang="en">
<body>
<div class="span3" id="sidebar">

  <div class="widget">
  <h4 class="widgetTitle">HHH病院</h4>
  <ul><li>神奈川県横浜市</li>
  <li>kanagawa02A</li></ul></div>

  <div class="widget">
  <h4 class="widgetTitle">株式会社III</h4>
  <ul><li>神奈川県横浜市</li>
  <li>kanagawa02B</li></ul></div>

  (20社分)

</div>
</body>
</html>



※以下は 会社と住所と電話番号のHTMLファイル((2)の例)です。

<!DOCTYPE html>
<html lang="en">
<body>
<div class="span3" id="sidebar">

  <div class="widget">
  <h4 class="widgetTitle">HHH病院</h4>
  <ul><li>神奈川県横浜市</li>
  <li>電話番号</li></ul></div>

</div>
</body>
</html>

作成してあるフォルダの中にテキストファイル(html)を格納する事は可能でしょうか。

フォルダはすでに作成してあります。
デスクトップ>zenkoku>kanagawa>kanagawa01>kanagawa01A

ファイル名はすべて index.html  

(1)「kanagawa02」フォルダには 会社名と住所とF列の値(20社分)
  →20社ごとに01、02、03 となっています。

(2)「kanagawa02A」フォルダには 会社名と住所と電話番号(1社分のみ)


※以下は 会社と住所のHTMLファイル((1)の例)です。

<!DOCTYPE html>
<html lang="en">
<body...続きを読む

Aベストアンサー

フォルダを変化させるには
> デスクトップ>zenkoku>kanagawa>kanagawa01>kanagawa01A
これの「どこが」「どのセルに」対応して「変化するか」考えてください。

デスクトップ>zenkoku>[列D]>[列E]>[列F]でしょ?
これを組み込めばよい。

20社まとめる件は、あらかじめワークシートをソートしておけば良い。
※でも「20社にまとめる」は[列D]都道府県も考慮する必要があるのかな?
※これ以上の後出しは知りませんよ

Sub HTMLファイル出力改()

 ' http://oshiete.goo.ne.jp/qa/8787726.htmlの質問本文から改造
 ' ※PC引っ張り出してキーボード入力しましたが、EXCELが無いので無試験

 Dim myPath As String
 Dim i As Long
 Dim strPath as string  'HTML出力ファイルのパス
 dim nFile as long   'ファイルハンドル
 dim nCount as long   '20社判定

 ’環境変数からデスクトップフォルダへのパスを定義する
 myPath = Environ("USERPROFILE") & "\Desktop\Zenkoku\"

 ’20社単位で処理できるよう、ソートする
 Range("A:F").Sort Key1:=Range("E2"), Key2:=Range("F2"), _
   Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom

 nCount = 0
 
 For i = 2 To Range("F1").End(xlDown).Row

  ' ブレーク判定1:前行と現在行を比較する
  '  処理が必要なのは「初回」または「20社単位名が変わる」
  '  ※初回は見出し行≠データ1行目であること
  ' 20社の場合
  If Range("E" & i - 1).Text <> Range("E" & i ).Text Then
  ' 1社の場合
''''If Range("E" & i - 1).Text & "|" & Range("F" & i - 1).Text <> Range("E" & i ) & "|" & Range("F" & i ).Text Then

   
   'ファイルハンドルの空きを取得
   nFile = freefile()

   '-出力パスの作成--ここから---------------------------------
   ’20社の場合
   strPath = myPath & Range("E" & i).Text & "\" & Range("F" & i).Text
   ’ 1社の場合
 ''''strPath = myPath & Range("E" & i).Text & "\" & Range("F" & i).Text "\" & Range("G" & i).Text
   '-出力パスの作成--ここまで---------------------------------

   ' 出力ファイルを開く
   Open strPath & "\index.html" For Output As #nFile

   '-20社共通部分1出力--ここから---------------------------------
   Print #nFile, "<!DOCTYPE html>" & vbNewLine _
     & "<html lang=""en"">" & vbNewLine _
     & "<body>" & vbNewLine _
     & "<div class=""span3"" id=""sidebar"">" & vbNewLine
   '-20社共通部分1出力--ここまで---------------------------------

   nCount = 0

  End If

  '-20社個別部分出力--ここから---------------------------------
  Print #nFile, vbNewLine _
    & "<div class=""widget"">" & vbNewLine _
    & "<h4 class=""widgetTitle"">" & Range("A" & i) & "</h4>" & vbNewLine _
    & "<ul><li>" & Range("B" & i) & "</li>" & vbNewLine _
    & "<li>" & Range("F" & i) & "</li></ul></div>" & vbNewLine
  '-20社個別部分出力--ここまで---------------------------------

  ’20社単位の出力件数をインクリメント
  nCount = nCount + 1

  ' ブレーク判定2:現在行と次行を比較する
  '  処理が必要なのは「次行は20社単位名が変わる」または「先ほどの出力が20社目」
  '  ※データ最終行の次行は空白等であること
  ' 20社の場合
  If Range("E" & i).Text <> Range("E" & i - 1).Text or nCount = 20 Then
  ’ 1社の場合
''''If Range("E" & i).Text & "|" & Range("F" & i).Text <> Range("E" & i + 1) & "|" & Range("F" & i + 1).Text Then

   '-20社共通部分2出力--ここから---------------------------------
   Print #nFile, "</div>" & vbNewLine & "</body>" & vbNewLine & "</html>"

   ' 出力ファイルを閉じる
   Close #nFile

   nCount = 0

   '-20社共通部分2出力--ここまで---------------------------------
  End If

 Next i

End Sub

フォルダを変化させるには
> デスクトップ>zenkoku>kanagawa>kanagawa01>kanagawa01A
これの「どこが」「どのセルに」対応して「変化するか」考えてください。

デスクトップ>zenkoku>[列D]>[列E]>[列F]でしょ?
これを組み込めばよい。

20社まとめる件は、あらかじめワークシートをソートしておけば良い。
※でも「20社にまとめる」は[列D]都道府県も考慮する必要があるのかな?
※これ以上の後出しは知りませんよ

Sub HTMLファイル出力改()

 ' http://oshiete.goo.ne.jp/qa/8787726.htmlの質問本文...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング