条件に応じたデータ転記　ExcelVBA

総合スコア16

sazi

2019/03/07 04:04

折角なんだから、マークダウンして下さい。

2019/03/07 04:59

saziさん、すみません。マークダウンの意味がわからず、とりあえずコードの挿入で編集してみたのですがこれでいいのでしょうか？

sazi

2019/03/07 05:04

OKです。

2019/03/07 05:10

ありがとうございました。勉強になりました。

2019/03/07 07:06

ひとまず解決したようで何よりです。今回の質問された内容に対しては、十分な成果物が出来上がったように思います。ところで、このあとコピーする列を100列まで増やしていくものと思います。当面はこの調子で、例えば「元データシートの10列目の値を、管理簿シートの8列目にコピー」といった処理を書き足していけばいいでしょう。では、その後シートを使っているうちに、管理簿シートに新たな情報を表示したくなった（例えば3列目に列追加したくなった）としたらどうでしょう？「元データシートの10列目の値を、管理簿シートの8列目にコピー」だった処理は「元データシートの10列目の値を、管理簿シートの9列目にコピー」に修正する必要がでてきます。これをどうにかメンテナンスしやすくしようと考えてくれていたのが、ttyp03さんの`dstcoltbl = Array(0, 1, 2, 3, 0, 0, 0, 0)`といったあたりの仕組みです。出力先のセルに対して、左から`{個別に加工, A列をコピー, B列をコピー, C列をコピー, 個別に加工…}`といった具合に判断できるようになってます。こうしておくと例えば3列目に加工データが追加されたとしても、`dstcoltbl = Array(0, 1, 0, 2, 3, 0, 0, 0, 0)`といった変更ですむので、4列目以降への影響を極力減らすような工夫がされているわけです。実際には個別処理の中の列番号なども変えなければいけないので、これだけではすまないのですが、極力手間がかからないようにという思いが込められていたのですね。難しいとは思いますが、余裕ができたらここらへんも掘り下げて理解を深めてみてください。

2019/03/07 08:07

実際の元データには100列近くのデータがあり、今回は管理簿にその中の30列ぐらいを転記しながらチェックしていきます。しかもただ転記されるのではなく並びがランダムになります。例えば、Ａ列＝Ａ列となるのは最初だけでＢ列＝Ｊ列、Ｃ列＝Ｆ列、Ｄ列＝Ｇ列＋Ｎ列…のように。しかも元データの後半の列で転記する行かどうかを判断しており、何度試してみてもttyp03さんのコードを使って実現することができませんでした。そのためttyp03さんのコードとjawaさんが教えてくれた考え方で自己解決で書いたコードになりました。 VBAは難しくてわからないことだらけですが思い通りに動いた時の達成感があるのでこれからも頑張っていきたいとおもいます。 ttyp03さん、jawaさん、改めてありがとうございました。

2019/03/07 09:18

やることはたくさんありそうですが、ひとつひとつは今回できたものと同じだったり、組み合わせだったりが多いと思います。こういったものはコツコツとやるしかないのでがんばってください。あと、元データの最後の方の列だからといって、処理の終盤でチェックしなければいけないわけではないですよ。必要な処理は、前半でも、中盤でも、必要な時にやればいいのです。ちなみにttyp03さんのサンプルコードでも「元データの列順」は特に処理の順序に関与していません。処理は記録簿の列順に進めていますよね。ためしに私の回答にメンテナンス性を考慮したサンプルコードを追記しました。 100列対応の際の参考になれば幸いです。

行動規範の内容に同意します

現段階では、どの機能が実現できそうで、どこが厳しそうなのか、想像もつかない状態ではないのでしょうか？
慣れないうちはよく陥ることなのですが、全体ばかりを見てしまうと途方もない大物に思えて最初の一歩が踏み出せなくなります。

大事なのは最終的に実現したいものを、細かな機能にわけて、１つずつ着実に実装していくことです。
慣れてくると２～３機能をまとめて考慮して組めるようになったりしてきますが、基本は１つずつです。

今回の場合、例えば

①元データから１行ずつ対象行を取得するループ処理を作成する ⇒For～Next文など

②管理簿の前回最終行を見つける ⇒ Range.End(xlUp)

③②の１つ下の行に、元データから「番号」「姓」「名」を転記する

④「セイ」と「メイ」を連結して「フリガナ」に出力する　⇒文字列連結
⑤「支社」と「部署」を結合して「支社」に出力する

⑥「申請１」と「申請２」は「不要」でない場合のみ転記する ⇒IF文など

⑦「承認」がない行は読み飛ばし、次のデータを処理する機能を追加する

⑧「チェック」が空白でない行は読み飛ばし、次のデータを処理する機能を追加する

のような手順に分解して考えてみます。

まずは①～③の機能を作ってみます。
これが実装できると、単純に右から左へ無条件に転記する機能ができあがります。

そこに④⑤のような元の値を加工して出力する機能、⑥のような条件によって異なる値を出力する機能を実装します。
さらに⑦⑧のような条件によっては元データの行を読み飛ばす機能を実装すれば、やりたいことがすべて実装されていると思います。

段階を追って、ひとつずつクリアしていく中で「これの実現方法が調べてもわからない」といったことがわかってくれば、それは大きな進歩です。
わからないことを（自分で調べたことも含めて）質問していただければ、お力添えできると思います。
がんばってみてください。

（追記：2019/03/07　18：00）

解決済みですが、ご自身で作成されたコードが提示されましたので、私からもサンプルコードを提供いたします。
※ttyp03さんのアドバイスを参考に、メンテナンス性を考慮する案を盛り込んだものです。

'コピー元の列番号
Enum ReadCols
    番号 = 1
    性
    名
    セイ
    メイ
    申請1
    申請2
    支社
    部署
    チェック
    承認
End Enum

'コピー先の列番号
Enum WriteCols
    番号 = 1
    性
    名
    フリガナ
    支社
    申請1
    申請2
    
    LAST
End Enum

Sub test()
    Dim srcws As Worksheet
    Dim dstws As Worksheet
    Dim i As Long
    Dim iCol As Integer
    
    Dim dstrow As Long
    Dim srcrow As Long
    
    On Error GoTo ErrorHandler
    Set srcws = Worksheets("元データ")
    Set dstws = Worksheets("管理簿")
    
    '管理簿最終行を求める
    dstrow = dstws.Range("A" & Rows.Count).End(xlUp).Row + 1
    '元データ最終行を求める
    srcrow = srcws.Range("A" & Rows.Count).End(xlUp).Row
    
    '出力先の各セルについて、コピー元の列を設定する
    Dim dstcoltbl(100) As Long
    Call DefineColumns(dstcoltbl)
    
    '元データ行ループ
    For i = 2 To srcrow
    
        If srcws.Cells(i, ReadCols.承認).Value = "承認" Then
            If srcws.Cells(i, ReadCols.チェック).Value = "" Then
                
                '出力先1列目～最終列までループ処理
                For iCol = 1 To WriteCols.LAST - 1
                    If dstcoltbl(iCol) <> 0 Then
                        dstws.Cells(dstrow, iCol).Value = srcws.Cells(i, dstcoltbl(iCol)).Value
                    Else
                        '加工する項目
                        Select Case iCol
                            Case WriteCols.フリガナ
                                dstws.Cells(dstrow, iCol).Value = StrConv(srcws.Cells(srcrow, ReadCols.セイ).Value & "　" & srcws.Cells(srcrow, ReadCols.メイ).Value, vbWide)
                            Case WriteCols.支社
                                dstws.Cells(dstrow, iCol).Value = StrConv(srcws.Cells(srcrow, ReadCols.支社).Value & srcws.Cells(srcrow, ReadCols.部署).Value, vbWide)
                            Case WriteCols.申請1
                                If (srcws.Cells(i, ReadCols.申請1).Value) = "必要" Then
                                  dstws.Cells(dstrow, iCol).Value = srcws.Cells(i, ReadCols.申請1).Value
                                Else
                                  dstws.Cells(dstrow, iCol).Value = ""
                                End If
                            Case WriteCols.申請2
                                If (srcws.Cells(i, ReadCols.申請2).Value) = "必要" Then
                                  dstws.Cells(dstrow, iCol).Value = srcws.Cells(i, ReadCols.申請2).Value
                                Else
                                  dstws.Cells(dstrow, iCol).Value = ""
                                End If
                            Case Else
                                '処理方法が見つからない列は空欄で出力
                                dstws.Cells(dstrow, iCol).Value = ""
                        End Select
                    End If
                Next
                
                '出力先の行番号をインクリメント
                dstrow = dstrow + 1
            
            End If
        End If
    
    Next
    
    '罫線を引く
    dstws.UsedRange.Borders.LineStyle = True
    
    Exit Sub
    
ErrorHandler:
    MsgBox "元データを追加してください。"

End Sub

'コピー元の列を設定する関数
Private Sub DefineColumns(ByRef rColsTbl() As Long)
    'あえて項目毎に１：１で書いてみた。管理しやすければこれもアリ。
    rColsTbl(WriteCols.番号) = ReadCols.番号
    rColsTbl(WriteCols.性) = ReadCols.性
    rColsTbl(WriteCols.名) = ReadCols.名
    rColsTbl(WriteCols.フリガナ) = 0        '加工
    rColsTbl(WriteCols.支社) = 0            '加工
    rColsTbl(WriteCols.申請1) = 0           '加工
    rColsTbl(WriteCols.申請2) = 0           '加工
End Sub

投稿2019/03/04 08:45

編集2019/03/07 09:23

総合スコア3013

2019/03/07 03:34

コメントありがとうございます。ご指摘のとおり一つに考えずに段階を追ってクリアしていく方法で無事解決できました。ありがとうございました。

2019/03/08 02:09

列挙型変数 Enumを宣言セクションで設定しておけば宣言しておいた内容がWriteCols.までいれると表示してくれるのですね！番号 = 1　だけ書いておけばあとは順に+1で割り当てられるのですか？「＝1」を入れなければ0から割り当てられてしまうので列番号と一致させるために「番号 = 1」としているという解釈でいいのでしょうか？定数のConstは使ったことがあったのですがEnumは初めて知りました。これなら何列目だったかわからなくならないので見た目にもメンテナンス的にもわかりやすいです。あと処理方法が見つからない列は空欄で出力という発想もなかったので目からウロコです。

2019/03/08 07:12 編集

Enumについては、ご理解いただいている通りです。 1列目からの連番、という意味でそのように記述しました。こうしておくと、あとから列の割り込みがあったときもEnumに項目追加するだけで以降の番号は自動でズレてくれるので便利です。読み取り列については、全ての列が必要になるわけではないなら必要無いものは飛ばしても大丈夫です。その場合は Enum ReadCols 順番=1 名=3 メイ=5 End Enum のように、それぞれ列番号を明示すれば大丈夫です。

行動規範の内容に同意します

ベストアンサー

基本的な構造だけ書いてみました。
足りないところは適宜足してください。
考え方としては特殊なケース以外は単純コピー、そうでない場合のみ加工している感じです。
元と先で列の順番が入れ替わったりしているところがありそうなので、先に対する元のデータの位置（列番号）をdstcoltblという配列に定義するようにしています。
要素(1)以降が列番号に対応しています。
値が0の要素が特殊ケースという扱いにしています。
フリガナと支社の処理は入れてみたので、他のもご自分でやってみてください。
dstcoltblの定義（Arrayしているところ）や管理簿の最終行を求めるところの実装もしてください。

VBA
1Dim srcws As Worksheet
2Dim dstws As Worksheet
3Dim srcrow As Long
4Dim dstrow As Long
5Dim dstcoltbl() As Variant
6Dim c As Long
7
8Set srcws = Worksheets("元データ")
9Set dstws = Worksheets("管理簿")
10
11'管理簿最終行を求める
12dstrow '= ○○
13
14'対応テーブル
15dstcoltbl = Array(0, 1, 2, 3, 0, 0)
16
17'元データ行ループ
18srcrow = 2
19Do While srcws.Cells(srcrow, 1).Value <> ""
20    '管理簿列ループ
21    dstcol = 1
22    For c = 1 To UBound(dstcoltbl)
23        If dstcoltbl(c) <> 0 Then
24            '単純コピー
25            dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, dstcoltbl(c)).Value
26        Else
27            '特殊ケース
28            Select Case c
29                Case 4 ' フリガナ
30                    dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, 4).Value & "　" & srcws.Cells(srcrow, 4).Value
31                Case 5 ' 支社
32                    dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, 8).Value & srcws.Cells(srcrow, 9).Value
33            End Select
34        End If
35    Next
36    srcrow = srcrow + 1
37    dstrow = dstrow + 1
38Loop
39

投稿2019/03/04 07:15

総合スコア16998

2019/03/04 08:50

おい、初心者にいきなりVariant型を教えるなよ。基本がしっかりと出来てから教えなさい^^;

2019/03/04 08:56

Arrayで代入するのに致し方なく。初心者向けに Dim dstcoltbl(100) As Long dstcoltbl(0) = 0 dstcoltbl(1) = 1 dstcoltbl(2) = 2 ・・・と延々書いてもいいんですけど、さすがにあれなんで。実践で覚えてもらえればよいかと。

2019/03/04 09:09

その場合ならfor文回せばいいのでは？あとその場合、メンテナンス上の観点から見るとそのやり方はおススメ出来ませんね。

2019/03/04 09:14

単純に同じ順番では並んでいないようなのでループでは回せずテーブルをかましてるわけです。別に業務として私が請け負っているわけではないので、メンテナンスのことまでは何とも。というかむしろメンテナンスはしやすいと思いますけどねぇ。まあ100列分並べたら確かにあれかもしれませんが。質問の趣旨としては作り方をどうしたらいいのか悩んでいるようでしたので、あくまでも考え方の例として書いています。共感できるなら採用して適当に修正加えてもらえればいいですよ。

2019/03/05 00:56 編集

stdioさま、ttyp03さま、コメントありがとうございます。 '対応テーブル dstcoltbl = Array(0, 1, 2, 3, 0, 0, 0, 0) '元データ行ループ srcrow = 2 Do While srcws.Cells(srcrow, 1).Value <> "" '管理簿列ループ ' dstcol = 1 For c = 1 To UBound(dstcoltbl) If dstcoltbl(c) <> 0 Then '単純コピー dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, dstcoltbl(c)).Value Else '特殊ケース Select Case c Case 4 ' フリガナ dstws.Cells(dstrow, c).Value = StrConv(srcws.Cells(srcrow, 4).Value, vbWide) & "　" & StrConv(srcws.Cells(srcrow, 5).Value, vbWide) Case 5 ' 支社 dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, 8).Value & srcws.Cells(srcrow, 9).Value Case 6 ' 申請1 If srcws.Cells(srcrow, 6).Value = "必要" Then dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, 6).Value End If Case 7 ' 申請2 If srcws.Cells(srcrow, 7).Value = "必要" Then dstws.Cells(dstrow, c).Value = srcws.Cells(srcrow, 7).Value End If End Select End If Next srcrow = srcrow + 1 dstrow = dstrow + 1 Loop このようにすることで半角カナは全角に変換して連結支社の連結申請１、申請２は値が”必要”の時だけ転記それ以外はそのままコピーができました。かなりの進歩です。ありがとうございます。ただ、チェックが空白、承認が空白な場合に転記対象から除外したいのですが後半の列にあるのでこちらが解決できていません。上記コードではすべての元データを転記してしまいます。一番最初の列であれば最初にIf構文で除外しようと思うのですが後半の列になるので手前までがすべて転記されてしまっている状態になってしまいます。一番最初に元データの10列目と11列目を確認することはできるのでしょうか？あと '管理簿列ループの下に dstcol = 1　というのがありますがこれは宣言されていないのでエラーになってしまったのですがどこかで利用する必要がある変数ですか？一応Dim dstcol As Longを入れたらエラーは解消したのですが… 初心者ですみませんがご教授いただければと思います。

2019/03/05 00:48 編集

dstcoltbl は行の定義ではなく列の定義です（単に書き間違いでしょうか）＞場合は列番号のかわりに0を入れて行き、Selectでその行数を指定して加工内容を記載していけばいいのでしょうか？そんな感じです。回答したコードのフリガナの例とか参考にしてもらえればわかりやすいかと。 dstcolの件は定義漏れです。すみません。その対応で問題ありません。

2019/03/07 04:07

具体的なコードをのせていただいたおかげで発想の転換ができました。今回元データと管理簿の並びが違うこと、後半のセルで抽出条件を絞り込むことから配列を使わずにそれぞれの値を必要なセルに代入するやり方で思い通りのものができました。 ttyp03さんのコードをみなければ思いつかなかったのでこちらをベストアンサーに選ばせていただきました。どうもありがとうございました。

行動規範の内容に同意します

参考まで。
ExcelでPowerQueryを使ってデータ収集分析
 Excelの集計をSQLでおこなう方法。VLOOKUP()やSUBTOTAL()の限界を超えろ！！

投稿2019/03/04 06:40

編集2019/03/04 06:43

sazi

総合スコア25195

2019/03/07 03:35

コメントありがとうございました。 PowerQueryは会社のパソコンではインストールすることができませんでしたがいろいろ勉強になりました。

行動規範の内容に同意します

基本的にプログラムなので一個一個こなしていくしかありません。

1.メンテナンスまで考えると、最初の1列目で必要な情報の列を探索。
2.一つ一つの要素を構造体配列に格納。結合させたらいいだけのデータ等はこの時点で結合させておく。
3.別のエクセル（この場合は管理簿）のシートに構造体配列の情報を登録させる。

VBAの場合はシートの更新を止めてから、シートの情報を書いた方が処理的に早い為、
下記のコードを書いておいた方が処理速度が格段に上がりますよ。

VBA
1'シートに何かを書く前に
2Application.ScreenUpdating = False
3Application.EnableEvents = False
4Application.Calculation = xlCalculationManual

VBA
1'シートに何かを書き終わったあとに、
2Application.ScreenUpdating = True
3Application.EnableEvents = True
4Application.Calculation = xlCalculationAutomatic

投稿2019/03/04 06:09

総合スコア3307

2019/03/04 08:20

構造体配列というのは普通の配列とはまた違うのでしょうか？よくわからないので勉強してみます。処理速度を上げる上記の３行はいつも入れるようにしています。ありがとうございます。

2019/03/04 08:46

いつも入れる必要はありません。シートに何かをsetする時だけは上記の3行を入れていた方が良いですよ。