柔軟に働き方を選ぶ時代に必要なこと >>

1つのフォルダの中に複数のExcelファイルが保存されています。

seat1だけを1つに集めたExcelファイルを新規で作成したいです。
※シート1をどんどん追加させるイメージです。
※フォルダの中に入っているExcelファイル数は毎月変わります。

手順(1)フォルダに入っているExcelシートを開く
手順(2)sheet1を【シートの移動またはコピー】新規BOOKにコピー
手順(3)フォルダに入っているExcel分繰り返す。
手順(4)シート名を変更する。
  
どういう風にVBAコードを記入すればいいかわからないので教えていただきたいです。どうぞよろしくお願いいたします。

「Q【Excel VBA】1つのファイルに」の質問画像

A 回答 (1件)

こんにちは



>どういう風にVBAコードを記入すればいいかわからないので
どのあたりがわからないのか不明なので、大雑把な記述法だけ・・・
(全部がまったくわからないないというのなら、作成するのはまだ無理かも知れません)

>手順(1)フォルダに入っているExcelシートを開く
いきなりシートは開けないので、ブックを開く→シートを選択 などの手順になるでしょう。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

>手順(2)sheet1を【シートの移動またはコピー】新規BOOKにコピー
https://docs.microsoft.com/ja-jp/office/vba/api/ …

>手順(3)フォルダに入っているExcel分繰り返す。
いわゆるループとなりますが、具体的な方法はいろいろ考えられます。
フォルダ内のファイルを検索するので、Dir関数を利用するループが簡単かもしれません。
https://docs.microsoft.com/ja-jp/office/vba/lang …
https://www.sejuku.net/blog/34439

>手順(4)シート名を変更する。
単純に、シートのName属性を変更するだけです。
https://docs.microsoft.com/ja-jp/office/vba/api/ …
    • good
    • 1

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

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

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

QCSVで文字化けしてしまうのを直すマクロ

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例 空白→""、 神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With

’別のマクロ実行

End if
Next i1

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/fil...続きを読む

Aベストアンサー

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでし...続きを読む

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む

Q4142から653347と飛んでます。 これを4143からちゃんと並ぶにはどうすればいいでしょうか?

4142から653347と飛んでます。
これを4143からちゃんと並ぶにはどうすればいいでしょうか?

Aベストアンサー

これ、9から70に飛んでるよね。

①シート全体を選択
②どの行でもいいので右クリック
③再表示を選択

開いたかな?

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

Q文字列になっている数値の日付変換はわかるのですが、20190204 → 2019/02/04ではなく

文字列になっている数値の日付変換はわかるのですが、20190204 →
2019/02/04ではなく
20190204→2月4日と一発変換となる関数式や設定などありますか?
よろしくおねがいします。

Aベストアンサー

数式: =(TEXT(A1,"0000!/00!/00"))*1
書式: m"月"d"日"

Qエクセルのデータ抽出方法を教えてください

下記のような表から、A列のコードをもとにして「D」列の「3」行目の100、200、300(ピンク色)のセルを参照したいのですが関数がわかりません。
別のシートに10000なら100、20000なら200と表示させたいです。
vlookupでは行が1行でないとできませんでした。

Aベストアンサー

以下でいかがですか。
H2 =INDEX(E2:E13,MATCH(G2,A2:A13,0)+1)

QエクエルのVBAについての質問です。 一つのフォルダにエクセルシートが100個あります。 そのシート

エクエルのVBAについての質問です。

一つのフォルダにエクセルシートが100個あります。
そのシート一つ一つのA11セルに
=SUM(A2:A10)
の計算式を入力するようなVBAを作ることはできないでしょうか

Aベストアンサー

できると思います。

QVBA/GetTickCountの49.7日の境目を跨ぐ時の処理

たまたまGetTickCountの49.7日の境目を通過したと思しき値の急変を経験しました。
ログで処理時間を記録する必要があり、GetTickCountを使用していましたが、境目を意識したプログラムになっていません、下記にて修正を加えるつもりです。

『メイン側』
Dim arg_apiS As Long
arg_apiS = GetTickCount
・・・・処理・・・・
Dim arg_apiN As Long
Dim arg_subTime As Long
arg_apiN = GetTickCount
Call ******(arg_apiS, arg_apiN, arg_subTime)
select case arg_subRslt
・・・・・・
『CallSub側』
Sub ******(ByRef arg_apiS As Long,arg_apiN As Long, arg_subTime As Long)
Select Case True
Case arg_apiS < arg_apiN
arg_subRslt = arg_apiN - arg_apiS
Case arg_apiS < arg_apiN
arg_subRslt = (2 ^ 32 - arg_apiS) + arg_apiN
End Select

単純動作は確認OKですが、境目の模擬的発生もできず・・・
境目を跨いだ状態でも、正常に動くのか確認したく質問しました。
よろしくお願いします。

たまたまGetTickCountの49.7日の境目を通過したと思しき値の急変を経験しました。
ログで処理時間を記録する必要があり、GetTickCountを使用していましたが、境目を意識したプログラムになっていません、下記にて修正を加えるつもりです。

『メイン側』
Dim arg_apiS As Long
arg_apiS = GetTickCount
・・・・処理・・・・
Dim arg_apiN As Long
Dim arg_subTime As Long
arg_apiN = GetTickCount
Call ******(arg_apiS, arg_apiN, arg_subTime)
select case arg_subRslt
・・・・・・
『CallSub側...続きを読む

Aベストアンサー

Case arg_apiS < arg_apiNはまずいですね。
arg_apiS = 49.6日
arg_apiN = 49.8日(オーバーフローして0.1日となる)
この場合に意図した動作になりません。

このサブルーチンの中でもう一度GetTickCountで時間を取得します。仮にこの時間をXとしましょう。
S = X - arg_apiS
N = X - arg_apiN
このSとNを比較すれば49.7日の境目の影響を受けません。検証してみましょう。
arg_apiS = 49.6日
arg_apiN = 0.1日(49.8日)
X = 1.0日

S = X - arg_apiS = 1.1日前(-48.7日のアンダーフロー)
N = X - arg_apiN = 0.9日前

比較すればarg_apiSの方が古いと正しく判断できます。

これが基本的なオーバーフロー(49.7日)問題の回避方法です。

Qマクロに関しての質問です。

現在、会社にて入出を管理している帳票が請求の為の入力と全く一緒で
所謂二重入力となっております。

業務引継ぎ時に面倒なので簡略化するようにと指示があったのですが
ファイル名の指定の段階でうまくいかず躓いております。

どなたかお分かりになる方がいらっしゃいましたらご教示頂けませんでしょうか。


内容
\\Ls-whglb3c\共有フォルダ\05.請求書関係\2019年度請求書関係\入力データ\豊橋データ入力_20190301.xlsxの「かんばんチェック表」シートA3:G140を
\\Ls-whglb3c\共有フォルダ\01.出入表\2019年\3月\出入表.xlsmの「原紙」シートのB2:H139へ転記したい


宜しくお願い致します。

Aベストアンサー

「かんばんチェック表」シートA3:G140を「原紙」シートのB2:H139にリンクするのは如何ですかね。

Q「-2147012889」というエラーでマクロが止まる

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).End(xlUp).Row
 Lastrow = Cells(Rows.Count, 1).End(xlUp).Row
 If getLine = Lastrow Then MsgBox "既に終わっているか、データがないです。", vbExclamation: Exit Sub
 If getLine < Lastrow And Cells(1, 2).Value <> "" Then
  getLine = getLine + 1
 Else
  getLine = 1 '最初の行が1行目からの場合
 End If
 For i = getLine To Lastrow
  strURL = LCase(Trim(Cells(i, 1).Value)) 'A列の登録URL
  strURL = Replace(strURL, "https:", "http:")
  If strURL Like "http*" Then
   objHttp.Open "GET", strURL, False
   objHttp.Send
   DoEvents 'ESC割り込み可能にする
   With objHttp
    If .Status = 200 Then
     nURL = .Option(1) 'WinHttpRequestOption_URL
     f = Mid(strURL, 1, InStr(strURL, "://"))
     l = Mid(nURL, 1, InStr(nURL, "://"))
     If nURL = "" Then
      Cells(i, 2).Value = "no URL"
     ElseIf nURL <> "" Then
      If LCase(f) = LCase(l) Then
       Cells(i, 2).Value = "non SSL"
      Else
       Cells(i, 2).Value = "https"
      End If
     End If
    Else
     Cells(i, 2).Value = "Err:" & .Status
    End If
   End With
  End If
Endline:
  nURL = ""
  strURL = ""
 Next i
 MsgBox "Finished"
 Exit Sub
ErrHandler:
 If Err() <> 0 Then
  Cells(i, 2).Value = Err.Number 'マイナスになるのは外部エラー
  GoTo Endline
 End If
End Sub

順調に動いていたのですが、頻繁にエラーで止まるようになってきました。
エラーの時にはセルに、「-2147012889」という数値が記入されます。

この「-2147012889」を避けて、
エラーが出さずに、マクロを動かすことは可能でしょうか?

どのような記述で、避けることができるのでしょうか?
よろしくお願いいたします。

先日、「そのドメインがSSL化してるかどうかをマクロで調べる」という、
質問をさせていただきました。

そこで書いていただいたマクロは、順調に動いていました。

'//
Sub TestSSLChecker2()
 Dim objHttp As Object
 Dim nURL As String
 Dim strURL As String
 Dim i As Long, f As String, l As String
 Dim Lastrow As Long, getLine As Long
 Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")

 On Error GoTo ErrHandler
 'A1から
 getLine = Cells(Rows.Count, 2).En...続きを読む

Aベストアンサー

No.1の回答者です。
「-2147012889」の数字が、本日、WiFiのエラーで出てきて考えたのですが、回線そのものの切断のようですね。一旦、エラーが出てくると、繰り返しなのか、復旧するまでにしばらく時間が掛かってしまいます。回線そのものを、有線LANにしたらと考えましたが、それは可能でしょうか。

今の所、IEオブジェクトを使ってやる方法を考えてはいるのですが、エラーでも、内部で済むのではないかと思います。しかし、いかんせん、ものすごく遅いのです。それにコードがややこしい上に、できるという保証はありません。他の良い手立てを思いつかないのです。ただ、Excel 2016ですと、まだ残されている方法があるかもしれません。


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

人気Q&Aランキング

おすすめ情報