Excel VBA質問箱 IV

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

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


2505 / 13645 ツリー ←次へ | 前へ→

【67644】2つのファイル間でのコピー&ペースト さや 10/12/20(月) 22:22 質問[未読]
【67648】Re:2つのファイル間でのコピー&ペースト Hirofumi 10/12/20(月) 23:44 回答[未読]
【67649】Re:2つのファイル間でのコピー&ペースト さや 10/12/21(火) 6:43 お礼[未読]
【67654】Re:2つのファイル間でのコピー&ペースト Jaka 10/12/21(火) 10:53 発言[未読]

【67644】2つのファイル間でのコピー&ペースト
質問  さや  - 10/12/20(月) 22:22 -

引用なし
パスワード
   困っています。教えて下さい。

下記のような2つのファイルがあります。
(1)のファイルのB列の数字を(2)のファイルのB列に持ってきたいのです。
(1)と(2)にはそれぞれ数十の支店毎のsheetが入っています。
また(2)のA列の項目は、(1)のA列の項目と行番号が異なるものもあります。


(1)【経費計画ファイル】

[sheet1:東京支店]
   A    B
1  人件費  50000
2  出張費  10000   
3  交通費  5000      
4  通信費  10000
5  雑費   20000

[sheet2:横浜支店]
   A    B
1  人件費  70000
2  出張費  20000   
3  交通費  3000      
4  通信費  40000
5  雑費   10000


(2)【経費実績ファイル】

[sheet1:東京支店]
   A    B
3  人件費 
4  出張費     
6  交通費        
8  通信費 
10  雑費  

[sheet2:横浜支店]
   A    B
1  人件費 
3  出張費     
5  交通費        
6  通信費 
7  雑費 


今は、2つのファイルを整列して表示させ、1sheetずつ、行番号を確認しながら、コピー&ペーストしています。sheetが数十もあり、毎月この作業をしないといけないので、何とか楽に出来る方法を教えて頂けませんか。

【67648】Re:2つのファイル間でのコピー&ペースト
回答  Hirofumi  - 10/12/20(月) 23:44 -

引用なし
パスワード
   こんなのでは

Option Explicit
Option Compare Text

Public Sub Main()

  Dim i As Long
  Dim wkbFrom As Workbook
  Dim wkbTo As Workbook
  Dim vntFrom As Variant
  Dim vntTo As Variant
  
  '経費計画Bookのシート名を列挙
  vntFrom = Array("東京支店", "横浜支店")
  '経費実績Bookのシート名を列挙
  vntTo = Array("東京支店", "横浜支店")
  
  Set wkbFrom = Workbooks("経費計画.xls")
  Set wkbTo = Workbooks("経費計画.xls")
  
  Application.ScreenUpdating = False
  
  For i = 0 To UBound(vntFrom)
    Post wkbFrom.Worksheets(vntFrom(i)).Range("A1"), _
          wkbTo.Worksheets(vntTo(i)).Range("A1")
  Next i
  
  Application.ScreenUpdating = True
  
  Set wkbFrom = Nothing
  Set wkbTo = Nothing
  
  MsgBox "処理が完了しました", vbInformation
  
End Sub

Private Sub Post(rngFrom As Range, rngTo As Range)

  '経費実績の列数(A〜B列)
  Const clngColumns1 As Long = 2
  '経費実績の中のKeyと成る列位置(基準列からのA列の列Offset:0列目)
  Const clngKey1 As Long = 0
  '転記先先頭列位置(基準列からのB列の列Offset:1列目)
  Const clngItem1 As Long = 1
  
  '経費計画の列数(A〜B列)
  Const clngColumns2 As Long = 2
  '経費計画の中のKeyと成る列位置(基準列からのA列の列Offset:0列目)
  Const clngKey2 As Long = 0
  '転記元先頭列位置(基準列からのQ列の列Offset:1列目)
  Const clngItem2 As Long = 1

  Dim i As Long
  Dim j As Long
  Dim lngRows1 As Long, lngRows2 As Long
  Dim vntKeys1() As Variant, vntKeys2() As Variant
  Dim vntData1() As Variant, vntData2() As Variant
  Dim rngResult As Range
  Dim lngStart As Long
  
  With rngTo
    '行数の取得
    lngRows1 = .Offset(Rows.Count - .Row, clngKey1).End(xlUp).Row - .Row + 1
    If lngRows1 <= 1 And .Value = "" Then
      Exit Sub
    End If
    '復帰用Keyを設定
    .Offset(, clngColumns1).EntireColumn.Insert
    With .Offset(, clngColumns1)
      .Value = 1
      .Resize(lngRows1).DataSeries Rowcol:=xlColumns, _
          Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    End With
    'A列をKeyとして整列
    .Resize(lngRows1, clngColumns1 + 1).Sort _
        Key1:=.Offset(, clngKey1), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    'Key列データを配列に取得
    vntKeys1 = .Offset(, clngKey1).Resize(lngRows1 + 1).Value
  End With
  '結果用配列を確保
  ReDim vntData1(1 To lngRows1, 1 To 1)
  
  With rngFrom
    '行数の取得
    lngRows2 = .Offset(Rows.Count - .Row, clngKey2).End(xlUp).Row - .Row + 1
    If lngRows2 <= 1 And .Value = "" Then
      Exit Sub
    End If
    '復帰用Keyを設定
    .Offset(, clngColumns2).EntireColumn.Insert
    With .Offset(, clngColumns2)
      .Value = 1
      .Resize(lngRows2).DataSeries Rowcol:=xlColumns, _
          Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
    End With
    'L列をKeyとして整列
    .Resize(lngRows2, clngColumns2 + 1).Sort _
        Key1:=.Offset(, clngKey2), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    'Key列データを配列に取得
    vntKeys2 = .Offset(, clngKey2).Resize(lngRows2 + 1).Value
    '転記データを配列として取得
    vntData2 = .Offset(, clngItem2).Resize(lngRows2).Value
  End With
  
  '経費実績を検索して見つかったその行を経費実績の「抽出データ」を転記
  lngStart = 1
  For i = 1 To lngRows1
    For j = lngStart To lngRows2
      ''経費実績のKeyが経費計画のKeyより大きければ
      If vntKeys1(i, 1) < vntKeys2(j, 1) Then
        'Forを抜ける
        Exit For
      Else
        '経費実績のKeyと経費計画のKey等しければ
        If vntKeys1(i, 1) = vntKeys2(j, 1) Then
          '出力用配列に転記
          vntData1(i, 1) = vntData2(j, 1)
          Exit For
        End If
      End If
    Next j
    If j <= lngRows1 Then
      lngStart = j
    Else
      Exit For
    End If
  Next i
  
  '結果を出力
  With rngTo
    .Offset(, clngItem1).Resize(lngRows1, 2).Value = vntData1
    '作業列をKeyとして整列
    .Resize(lngRows1, clngColumns1 + 1).Sort _
        Key1:=.Offset(, clngColumns1), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '作業列を削除
    .Offset(, clngColumns1).EntireColumn.Delete
  End With
  
  With rngFrom
    '作業列をKeyとして整列
    .Resize(lngRows2, clngColumns2 + 1).Sort _
        Key1:=.Offset(, clngColumns2), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '作業列を削除
    .Offset(, clngColumns2).EntireColumn.Delete
  End With
    
End Sub

【67649】Re:2つのファイル間でのコピー&ペースト
お礼  さや  - 10/12/21(火) 6:43 -

引用なし
パスワード
   Hirofumiさん

有難うございます。
しかし私はVBAが出来ず関数しか出来ないのです。

うっかりしていました。このサイトはVBA質問箱ですもんね。。

【67654】Re:2つのファイル間でのコピー&ペースト
発言  Jaka  - 10/12/21(火) 10:53 -

引用なし
パスワード
   >うっかりしていました。このサイトはVBA質問箱ですもんね。。
個人的には、気にしてません。
ただ、手に負えない数式だと、返信が付きにくいかもって程度。

使う状況が良くわかってないけど、
VLOOKUP なんかでもいいのかな?
値だけにしたいなら、後でセルのコピー、値だけ貼り付けってのもあるけど。

例、
=VLOOKUP(A3,[Book1]Sheet1!$A$1:$B$5,2,0)

一応張っておきます。
ht tp://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=142149&rev=0

2505 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free