個人事業主の方必見!確定申告のお悩み解決

はじめまして。
 異なるファイル間でそれぞれシート名を比較して、ないものがあればそのシートを元ファイルに追加したいのです。新ファイル(任意の位置に増加シートがあります)→元ファイル(新ファイルの増加シートを新ファイルと同じ並び順で追加される)
元ファイルはすでに記入してあるものなので、単純に上書きではまずいので、上記の様な方法を採りたいのですが、大きく3点でつまずいてます。
1.シート名を配列に格納 
2.配列の比較(存在の有無)
3.同じ位置に追加
と肝心なところがダメなわけでありますがなんとか助けて頂けないでしょうか?
1.2.はたぶんこの方法かなと思ってるだけですが。(For nextの2重ループでは挫折しましたので)

 仕様はマクロ記入ファイル(FARSTBOOKとしています)からコピー先ファイル(OLDBOOKとしています)とコピー元ファイル(NEWDBOOKとしています)を開き、それぞれを配列に格納して最初の流れで進めたいのです。指定したファイルを検索させて開くことや、シートの追加等はいつもやっているのですが、今回は複数と複数の比較で困っております。どなたか力を貸してください。

A 回答 (3件)

#1 です。

連投すみません。

修正したものを再度掲載しておきます。

Sub Sample()

  Dim wbSrc    As Workbook
  Dim wbDst    As Workbook
  Dim shSrc    As Object
  Dim shDst    As Object
  
  Set wbSrc = Workbooks("NEWBOOK.xls") ' // コピー元
  Set wbDst = Workbooks("OLDBOOK.xls") ' // コピー先
  
  ' // まず NEWBOOK.xls にあって OLDBOOK.xls にないシートを複写
  For Each shSrc In wbSrc.Sheets
    On Error Resume Next
    Set shDst = wbDst.Sheets(shSrc.Name)
    On Error GoTo 0
    If shDst Is Nothing Then
      shSrc.Copy After:=wbDst.Sheets(wbDst.Sheets.Count)
    End If
    Set shDst = Nothing ' <---- 追加
  Next

  ' // シート並べ替え
  For Each shDst In wbDst.Sheets
    shDst.Move Before:=wbDst.Sheets(wbSrc.Sheets(shDst.Name).Index)
  Next

End Sub
    • good
    • 0
この回答へのお礼

KenKen_SPさんへ
ありがとうございました。お陰さまで肝心な所が出来上がりました。
複数と複数などと考えていましたが、ひとつずつ順次比較すればよかったのですね。また、ブックとシートの変数もスタートとデストネーションで分かり易くつけて頂き助かりました。
更に、shDst.Move Before:=wbDst.Sheets(wbSrc.Sheets(shDst.Name).Index)
まで教えて頂きました。
後は、実際のものに組み入れてみます。ありがとうございます。
またよろしくお願いします。

お礼日時:2008/09/02 09:08

ごめんなさい。

#1 です。

> shSrc.Copy Before:=wbDst.Sheets(shSrc.Index)

だとエラーがでますね。確認もしないで投稿してしまいすみません。
同じ位置....というのがよく分からないのですが、NEWBOOK.xls 内
での並びのままというのであれば、

 shSrc.Copy After:=wbDst.Sheets(wbDst.Sheets.Count)

とでもして下さい。NEWBOOK.xls と OLDBOOK.xls のシートの並びを
完全に一緒にしたいのであれば、シートの並べ替え処理も加えないと
いけないですね。
    • good
    • 0

こんにちは。



配列を使う必要性は感じません。メリットはほとんどないでしょう。
こんな感じではダメなのですか?

Sub Sample()

  Dim wbSrc    As Workbook
  Dim wbDst    As Workbook
  Dim shSrc    As Object
  Dim shDst    As Object
  
  Set wbSrc = Workbooks("NEWBOOK.xls") ' // コピー元
  Set wbDst = Workbooks("OLDBOOK.xls") ' // コピー先
  
  For Each shSrc In wbSrc.Sheets
    On Error Resume Next
    Set shDst = wbDst.Sheets(shSrc.Name)
    On Error GoTo 0
    If shDst Is Nothing Then
      shSrc.Copy Before:=wbDst.Sheets(shSrc.Index)
    End If
  Next

End Sub

なお、単にシートと書いてありますが、ワークシートとシートは
別物です。上記は「シート」で書いてます。

[参考]
Worksheets: ワークシートのみ
Sheets  : ワークシートに加え、グラフ、マクロ、ダイアログシートを含む

ゆえに
  Dim shSrc As Worksheet ではなく、
  Dim shSrc As Object
です。
    • good
    • 0

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

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

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

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

QExcel VBAで複数シートをコピーする

Excel VBAで複数のシートを新たらしいブックにコピーする方法が分かりません。

一応、Selectで全てのシートを選択し
コピーする方法は分かるのですが
出来ればSelectなどの画面遷移をプログラム内に含ませたくありません

シートは n件存在します。
ご存知の方がおられましたら
ぜひ、教えて頂けないでしょうか?

Aベストアンサー

すいません、勉強不足でした。
ただ単純に「全てのシートを選択」し「新規ファイルにコピー」という動作であれば、
sheets.Select
sheets.Copy
だけでできました。

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

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

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QExcel VBA シート名をすべて取得し、一覧をシートに入力したい

Excelで、トップのシートに、
他のシート名をすべて取得しセルに入力したいと思っています。
VBAを使って、それをワンボタンでやるようにできないかなと
思ったのですが、コードがうまく書けません。

ヒントいただけたらうれしいです。

Aベストアンサー

ヒントではなくて、回答の一つかも。
コードは自分で読んでみて下さい。

Sub test()
Dim ws As Worksheet
For Each ws In Worksheets
Cells(ws.Index, 1) = ws.Name
Next
End Sub

Qエクセルマクロ 変数をワークシート名で使用したい

Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("1月")
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("2月")

・・・・これが12月のws12まであります。

これとは別のシート(定義名:data)のあるセルには、数字(1~12)
までを入力し、ここの数字によってdataシートからどの月毎のシートに値を転記するかを
分岐させる仕組みのマクロを作成しようとしております。
※数字が7だったら、7月のws7に転記する。

ここで、変数を用いてできれば良いと思うのですが、うまくいきません。
現状、If .... then, elseif .... thenを12個作る方法しか思い浮かばず、コードの量が
膨大になってしまいます。

うまく分岐させる方法をご教示お願いいたします。
エクセル2003を使用しています。

Aベストアンサー

質問の意味を勘違いしているかもしれませんが、必要なシートのオブジェクトを作れば良いだけでは?

Dim ws As Worksheet
targetsheetname = Worksheets("data").Range("A1") & "月"
Set ws = ThisWorkbook.Worksheets(targetsheetname)

QExcelマクロ シート名を変数で選択

Excelマクロの初心者です。
シート名が「1月」・・・「12月」のある(変数定義された)部分を
コピー貼付けしたいのですが、
Worksheet(N & "月").Select
の行でコンパイルエラーになります。
何がいけないのでしょうか、ご存知の方教えてください。

Sub
Dim Namae As String
Dim N As Integer
For N = 1 To 12

Worksheet(N & "月").Select
Cells.Find(What:=Namae, LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0).Resize(RowSize:=405, ColumnSize:=4).Select
Selection.Copy

Windows("別ファイル").Activate
Sheets("XXX").Cells(3, 1 + N * 5).Select
Selection.PasteSpecial Paste:=xlPasteValues,
  Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
Next
End Sub

Excelマクロの初心者です。
シート名が「1月」・・・「12月」のある(変数定義された)部分を
コピー貼付けしたいのですが、
Worksheet(N & "月").Select
の行でコンパイルエラーになります。
何がいけないのでしょうか、ご存知の方教えてください。

Sub
Dim Namae As String
Dim N As Integer
For N = 1 To 12

Worksheet(N & "月").Select
Cells.Find(What:=Namae, LookIn:=xlValues, LookAt:=xlWhole).Offset(1, 0).Resize(RowSize:=405, ColumnSize:=4).Select
Selection.C...続きを読む

Aベストアンサー

Worksheets(N & "月").Select
「s」がないからでは?

QEXCELファイルのカレントフォルダを取得するには?

EXCELファイルのカレントフォルダを取得するには?

C:\経理\予算.xls

D:\2005年度\予算.xls

EXCEL97ファイルがあります。

VBAで
  カレントフォルダ名
(C:\経理\,D:\2005年度\)
を取得する事は可能でしょうか?

CURDIRでは上手い方法が見つかりませんでした。

Aベストアンサー

こんばんは。
Excel97 でも、同じですね。以下で試してみてください。

Sub test()
'このブックのパス
a = ThisWorkbook.Path
'アクティブブックのパス
b = ActiveWorkbook.Path
'Excelで設定されたデフォルトパス
c = Application.DefaultFilePath
'カレントディレクトリ
d = CurDir
MsgBox "このブックのパス   : " & a & Chr(13) & _
   "アクティブブックのパス: " & b & Chr(13) & _
   "デフォルトパス    : " & c & Chr(13) & _
   "カレントディレクトリ : " & d & Chr(13)
End Sub

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

Qエクセル VBA セルの個数を所得する

いつも皆様には大変お世話になっております。

早速の質問ですが、

    A    B     C     D     E
1
2       123
3       123
4       123
5       123
6
7       123
とエクセルのセルがなっている場合の
上のB2から下のB7までのセルの個数を所得したいのです
B8以降にも数字が入る場合があるのと間に空白が入る場合があるので
困っています。
B2のセルは固定となっているのでB2からの判別で問題ない状況です。
どうぞ皆様お知恵をお借りしたく思っておりますのでよろしくお願いいたします。

Aベストアンサー

質問が非常に不明確なのですが・・・

所得?取得ですよね?

単にB2:B7のセルの個数をVBAで取得するなら
MsgBox Range("B2:B7").Count

B2:B7の空白でないセルの個数なら
MsgBox Application.CountA(Range("B2:B7"))

B7まででなくB2からB列のデータがある最後までのセル個数なら
MsgBox Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Count

B2からB列のデータがある最後までの空白でないセル個数なら
MsgBox Application.CountA(Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row))


人気Q&Aランキング