[[20170807175819]] 『複数ファイルからの値取得、転記』(book) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数ファイルからの値取得、転記』(book)

エクセルの学校の皆様

お世話になります。bookと申します。
当方、vba初心者で、いろいろと至らない点も多いと思いますが、ご協力よろしくお願いします。
まず、私がマクロで行いことは「他の複数のエクセルファイルより値を取得し、元ファイルの様式に一括記入する」ということです。
具体的には、
 元ファイルの5行目にはその列が何を示しているのかを入力してあります。ここでは、社員情報をまとめるためのファイル(5行目1列目:名前、2列目:性別、3列目:評価点)とします。
 

 取り込みファイルは、ここでは各社員の情報ファイルとします。
各社員の情報ファイルは結合されたセルに情報が入力されています。
各社員の情報ファイルの様式はすべて同じ形式です。
名前は(行:7〜9、列:AD1〜AX1)これを元ファイルの6行目1列に入力
性別は(行:10〜12:AU〜AX1)これを元ファイルの6行目2列に入力

上記の2つは値を直接転記という処理を行いたいのですが、残りの評価という項目は条件が違います

評価セルは上2つの項目と違い決まったセルに入力されておりません。
行に関しては、評価の行(20〜22行目結合)が該当します。これは固定です。
問題は列で、列は5つのうちのどこかに入力されております。
その列は
(w20〜AA1、AB1〜AF1、AG1〜AP1、AQ1〜BF1、BG1〜BV1)の計5つの結合列です。
また、評価セルは必ずオレンジで塗りつぶされております。
このことを利用し、2つの対処(欲を言えば?Aのセル)案を考えました。
?@塗りつぶされたセルの値をそのまま元ファイルの6行目3列に転記
?A塗りつぶされたセルの同列、18〜19(結合)行の値を元ファイルの6行目3列に転記
具体的には、行:20〜22 列:w20〜AA1にある社員の評価が入力されているとして、その値ではなく行:18〜19:w20〜AA1の値を転記するという処理です。
?Aの場合、行:18〜19は固定で行が5つうちのどれかとなります。

備考
・一括転記は、このファイルと同じ階層にある.xlsxを対象とします
(ThisWorkbook.Path & "\"こういう表現を前にみたことがあります)
・社員aを元ファイルの6行目に入力したら、社員bは7行目という様にデータを格納したいです(順番は問いません)。
・元ファイル名の入力シートはsheet1、社員情報ファイルの転記元シート名は社員情報とします。

わかりにくい点があれば、補足します。
以上、よろしくお願いします。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


 読解力ないので、申し訳ございませんが、下記のツールを使って「元データ」と「転記後のデータ」を
 提示いただけますか?
[[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo)

(稲葉) 2017/08/07(月) 18:28


稲葉1様

ご返信ありがとうございます。
上記ツールだと、社員情報ファイルがごちゃごちゃになったため
今回は下記の簡易的な表現に変更します。

転記先(元ファイルと上記では記載)

    |[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)
・評価値は4行目で1〜5のどれか1セルが塗りつぶされている
その際、転記するのは1〜5ではなく3行目の値とする(たとえば評価が3ならCを
転記先ファイルの6行目3列に転記

 転記後イメージ
ここではあ、い、うという3名の情報を一括で転記するとする。

    |[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ファイルから一括に転記するということは可能でしょうか? 
 ですから、コード内にも書きましたが、ループ処理をするのでまずはレイアウト確定しましょう、というところまで説明しました。

 本題です。
 1)名前 性別 評価 のほかに7項目転記したいということですか?
 2)「うまくいかない」はどのようなコードのところで、どうなるのですか?
   「うまくいかない」全文を載せてください。

(稲葉) 2017/08/08(火) 14:54


稲葉様

お考えが理解できておらず、申し訳ございません。
同じブックの間違いでございます。

1)本当のことをお話しますと、この件の内容はダミーで、実際には名前や性別のような情報を転記するわけではございません。

名前、性別のように値をそのまま転記したい項目が23項目
評価のようにそのまま値をとるのではなく5つの列((w、AB、AG、AQ、BG)のうち色付けされている列の18行目の値を転記したい項目は32項目ございます(すべて18行目の色づき列の値を転記したいです)。

2)は
(book) 2017/08/08(火) 12:03の返信の様式に名前、性別のように値をそのまま転記したい項目のみ追記したところ下記のようにエラーがでました。

「実行時エラー9 インデックスが有効範囲にありません」
でデバックでは、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


 >名前、性別のように値をそのまま転記したい項目が23項目 
 と書いておられますが、実際どうなっているのですか?

 飛び飛びの数値になっていますが、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


その通りです。最終列は55列目です。
(book) 2017/08/08(火) 17:15

 ではまず上のコードで、シート間でできたら次に進みましょうか。

(稲葉) 2017/08/08(火) 18:12


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.