[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数ファイルからの値取得、転記』（book）
エクセルの学校の皆様
お世話になります。bookと申します。
当方、vba初心者で、いろいろと至らない点も多いと思いますが、ご協力よろしくお願いします。
まず、私がマクロで行いことは「他の複数のエクセルファイルより値を取得し、元ファイルの様式に一括記入する」ということです。
具体的には、
元ファイルの５行目にはその列が何を示しているのかを入力してあります。ここでは、社員情報をまとめるためのファイル（５行目１列目：名前、２列目：性別、３列目：評価点）とします。
取り込みファイルは、ここでは各社員の情報ファイルとします。 各社員の情報ファイルは結合されたセルに情報が入力されています。 各社員の情報ファイルの様式はすべて同じ形式です。 名前は（行：7～9、列：ＡＤ１～ＡＸ１）これを元ファイルの６行目１列に入力 性別は（行：10～12：ＡＵ～ＡＸ１）これを元ファイルの６行目２列に入力
上記の２つは値を直接転記という処理を行いたいのですが、残りの評価という項目は条件が違います
評価セルは上２つの項目と違い決まったセルに入力されておりません。
行に関しては、評価の行（20～22行目結合）が該当します。これは固定です。
問題は列で、列は５つのうちのどこかに入力されております。
その列は
（w20～AA1、AB1～AF1、AG1～AP1、AQ1～BF1、BG1～BV1)の計５つの結合列です。
また、評価セルは必ずオレンジで塗りつぶされております。
このことを利用し、２つの対処（欲を言えば?Aのセル）案を考えました。
?@塗りつぶされたセルの値をそのまま元ファイルの６行目３列に転記
?A塗りつぶされたセルの同列、18～19（結合）行の値を元ファイルの６行目３列に転記
具体的には、行：20～22 列：w20～AA1にある社員の評価が入力されているとして、その値ではなく行：18～19：w20～AA1の値を転記するという処理です。
?Aの場合、行：18～19は固定で行が５つうちのどれかとなります。
備考
・一括転記は、このファイルと同じ階層にある.xlsxを対象とします
（ThisWorkbook.Path & "\"こういう表現を前にみたことがあります）
・社員aを元ファイルの６行目に入力したら、社員ｂは７行目という様にデータを格納したいです（順番は問いません）。
・元ファイル名の入力シートはsheet1、社員情報ファイルの転記元シート名は社員情報とします。
わかりにくい点があれば、補足します。
以上、よろしくお願いします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
読解力ないので、申し訳ございませんが、下記のツールを使って「元データ」と「転記後のデータ」を 提示いただけますか？ [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）
（稲葉） 2017/08/07(月) 18:28
ご返信ありがとうございます。
上記ツールだと、社員情報ファイルがごちゃごちゃになったため
今回は下記の簡易的な表現に変更します。
転記先(元ファイルと上記では記載）
|[A] |[B] |[C]
[5]|名前|性別|評価
転記元ファイル(社員情報）
|[A] |[B]|[C]|[D]|[E] |[F]|[G]
[1]|名前| | |性別| |
[2]| | | | | | |
[3]|a |b |c |d |e | |
[4]| 5| 4| 3| 2| 1| |
・名前はA1からC2が結合セル（入力はA1）
・性別はD1らGが結合セル（入力はD1)
・評価値は４行目で１～５のどれか１セルが塗りつぶされている
その際、転記するのは１～５ではなく3行目の値とする（たとえば評価が3ならCを
転記先ファイルの６行目３列に転記
転記後イメージ
ここではあ、い、うという３名の情報を一括で転記するとする。
|[A] |[B] |[C]
[5]|名前|性別|評価
[6| あ 男 d
[7| い 女 c
[8| う 男 a
以上、よろしくお願いします。
（book） 2017/08/08(火) 12:03
たぶん、こんなカンジになると思うので、実際のファイルに併せて書き換えてもらえますか？ その後ブックのループ処理にしましょう。 まずはシート間の転記です。 転記元ブックにシートを一つ用意して、転記先として、必要な場所を実際のデータに合わせて変更してください。
Option Explicit
Sub test()
Dim ans As Variant
ReDim ans(1 To 3, 0)
Dim 転記先 As Worksheet
Set 転記先 = Sheets("転記先")
Dim 転記元 As Worksheet
'ここからブックのループ
ReDim Preserve ans(1 To 3, 1 To UBound(ans, 2) + 1)
Set 転記元 = Sheets("転記元")
ans(1, 1) = 転記元.Range("A1").Value
ans(2, 1) = 転記元.Range("D1").Value
Dim c As Long
Dim 評価 As String
For c = 1 To 5
If 転記元.Cells(4, c).Interior.ColorIndex <> xlNone Then
評価 = 転記元.Cells(3, c).Value
Exit For
End If
Next c
If 評価 = "" Then 評価 = "不明"
ans(3, 1) = 評価
評価 = ""
'ここまでブックのループ
転記先.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(ans, 2), 3).Value = Application.Transpose(ans)
End Sub
（稲葉） 2017/08/08(火) 12:52
ご返信ありがとうございます。
データの転記については、実際の様式にあわせて問題なく実行することができました。
あと、今回は
転記先と転記元が同じシートにあるという条件でのマクロだと思うのですが、
実際に社員情報ファイルはたくさんあることから、
たとえば、転記先のファイルと同じパスにある.xlsxファイルから一括に転記するということは可能でしょうか？
以上、よろしくお願いいたします。
（book） 2017/08/08(火) 13:20
何度も申し訳ございません。
先ほど問題ないと言ってしまったのですが、
ReDim Preserve ans(1 To 3, 1 To UBound(ans, 2) + 1)
Set 転記元 = Sheets("転記元")
ans(2, 1) = 転記元.Range("E1").Value
上記の直接値を転記する部分は、実際には10セル程度あり、
そのしたの行に
ans(3, 1) = 転記元.Range("AD7").Value
～～
ans(10, 1) = 転記元.Range("CB13").Value
のように追記したところ、
インデックスが有効範囲にないとエラーがでました。
ReDim Preserve ans(1 To 3, 1 To UBound(ans, 2) + 1)の部分を
ReDim Preserve ans(1 To 10, 1 To UBound(ans, 2) + 1)と変更したのですが、うまくいきませんでした。
なぜでしょうか？
対策を調べ中なのですが、もしわかればご回答していただけませんか？
よろしくお願いします。
（book） 2017/08/08(火) 14:01
＞転記先と転記元が同じシートにあるという条件でのマクロだと思うのですが、 同じブックの間違いですかね？
＞実際に社員情報ファイルはたくさんあることから、 ＞たとえば、転記先のファイルと同じパスにある.xlsxファイルから一括に転記するということは可能でしょうか？ ですから、コード内にも書きましたが、ループ処理をするのでまずはレイアウト確定しましょう、というところまで説明しました。
本題です。 １）名前 性別 評価 のほかに7項目転記したいということですか？ ２）「うまくいかない」はどのようなコードのところで、どうなるのですか？ 「うまくいかない」全文を載せてください。
（稲葉） 2017/08/08(火) 14:54
お考えが理解できておらず、申し訳ございません。
同じブックの間違いでございます。
１）本当のことをお話しますと、この件の内容はダミーで、実際には名前や性別のような情報を転記するわけではございません。
名前、性別のように値をそのまま転記したい項目が２３項目
評価のようにそのまま値をとるのではなく５つの列（（w、AB、AG、AQ、BG)のうち色付けされている列の18行目の値を転記したい項目は32項目ございます（すべて18行目の色づき列の値を転記したいです）。
２）は
（book） 2017/08/08(火) 12:03の返信の様式に名前、性別のように値をそのまま転記したい項目のみ追記したところ下記のようにエラーがでました。
「実行時エラー９ インデックスが有効範囲にありません」
でデバックでは、ReDim Preserve ans(1 To 3, 1 To UBound(ans, 2) + 1)の部分が示されました。
1 to 23にしたら良いのでは思い試しましたが、ダメでした。
以下にコードを記します。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit
Sub test()
Dim ans As Variant
ReDim ans(1 To 3, 0)
Dim 転記先 As Worksheet
Set 転記先 = Sheets("転記先")
Dim 転記元 As Worksheet
'ここからブックのループ
ReDim Preserve ans(1 To 3, 1 To UBound(ans, 2) + 1)
Set 転記元 = Sheets("転記元")
' ans(1, 1) = 転記元.Range("A1").Value コメント
' ans(2, 1) = 転記元.Range("E1").Value コメント
ans(1, 1) = 転記元.Range("AD7").Value
ans(2, 1) = 転記元.Range("AD10").Value
ans(3, 1) = 転記元.Range("AU10").Value
ans(4, 1) = 転記元.Range("AD13").Value
ans(5, 1) = 転記元.Range("BE7").Value
ans(6, 1) = 転記元.Range("CE7").Value
ans(7, 1) = 転記元.Range("BE7").Value
ans(8, 1) = 転記元.Range("BV10").Value
ans(9, 1) = 転記元.Range("BE13").Value
ans(10, 1) = 転記元.Range("CB13").Value
ans(17, 1) = 転記元.Range("CE20").Value
ans(18, 1) = 転記元.Range("CH20").Value
ans(24, 1) = 転記元.Range("CE38").Value
ans(30, 1) = 転記元.Range("CE53").Value
ans(31, 1) = 転記元.Range("CH38").Value
ans(38, 1) = 転記元.Range("CE84").Value
ans(39, 1) = 転記元.Range("CH84").Value
ans(45, 1) = 転記元.Range("CE102").Value
ans(46, 1) = 転記元.Range("CH102").Value
ans(50, 1) = 転記元.Range("CE117").Value
ans(51, 1) = 転記元.Range("CH117").Value
ans(54, 1) = 転記元.Range("CE126").Value
ans(55, 1) = 転記元.Range("CH126").Value
Dim c As Long
Dim 評価 As String
For c = 1 To 5
If 転記元.Cells(4, c).Interior.ColorIndex <> xlNone Then
評価 = 転記元.Cells(3, c).Value
Exit For
End If
Next c
If 評価 = "" Then 評価 = "不明"
ans(3, 1) = 評価
評価 = ""
'ここまでブックのループ
転記先.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(ans, 2), 3).Value = Application.Transpose(ans)
End Sub
（book） 2017/08/08(火) 15:24
配列の要素数を動的に増やすのは、最後の次元しかできません。
ですので、23にするのであれば
ReDim ans(1 To 23, 0)
~~
（省略）
ReDim Preserve ans(1 To 23, 1 To UBound(ans, 2) + 1)
~~
としてください。
（稲葉） 2017/08/08(火) 15:39
ご回答ありがとうございます。
変更し実行したところ、デバッグで以下が示されました。
ans(24, 1) = 転記元.Range("CE38").Value
この場合は
ReDim ans(1 To 55, 0)
~~
（省略）
ReDim Preserve ans(1 To 55, 1 To UBound(ans, 2) + 1)
とするのが正しいのでしょうか？
（book） 2017/08/08(火) 15:46
＞名前、性別のように値をそのまま転記したい項目が２３項目 と書いておられますが、実際どうなっているのですか？
飛び飛びの数値になっていますが、55列まで使うが空欄の項目もあるということですか？ （稲葉） 2017/08/08(火) 16:00
ans(1, 1) = 転記元.Range("AD7").Value
のようにそのまま値を転記する項目が23列あります。飛び飛びなのは、その飛び飛びの列は評価と同じように色つきのセルをとる列となります。
（book） 2017/08/08(火) 16:28
つまり、黄色いセルを含めると55になるということですか？
（稲葉） 2017/08/08(火) 16:49
ではまず上のコードで、シート間でできたら次に進みましょうか。
（稲葉） 2017/08/08(火) 18:12
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.