[[20180313124802]] 『複数のファイルに対して同じ処理を実行したい』(かりん58) ページの最後に飛ぶ

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

 

『複数のファイルに対して同じ処理を実行したい』(かりん58)

こんにちわ。よろしくお願いします。

ファイルの中身の項目が同じものが6種類あります。
AからK列の2行目に項目名があり、その下に値が入っています。行数は色々です。
これらのファイルに対して、以下の処理を実施するマクロを考えてます。

1.2行目に空白の行を追加する
2.B列、D列、G列、H列、I列を列ごと削除する
3.列幅を全て文字が表示されるよう整える(手動だと罫線の上ダブルクリックして表示される程度でいいです。)
4.D列(2.の削除後)3行目に『ユーザー名』という項目があるので、昇順で並び替えをする
5.F列に項目名以外2種類の値が入っているので、「ねこ」という値は青色(R220、G230、B241)でセルを塗りつぶし、「いぬ」という値は赤色(R255、他0)でセルを塗りつぶす
6.表に罫線をつける、細線実線で統一、
列横は全て罫線、行の罫線はD列のユーザー名が同じものは同じ枠で囲う
7.ファイルはcsvなので、同じファイル名で拡張子.xlsxで別ファイルとして保存する。(同じディレクトリで良いです)

 A   B     C       D       E      F
|------------------------------------------------------|
|場所|時刻|ユーザID |ユーザー名 |移動先|移動元|
|------------------------------------------------------|
|xx|md|1234|佐藤 学ぶ|xxx |ね  こ|
|xx|md|1234|佐藤 学ぶ|xxx |い  ぬ|
|xx|md|1234|佐藤 学ぶ|xxx |ね  こ|
|------------------------------------------------------|
|xx|md|5678|鈴木 花子|xxx |ね  こ|
|xx|md|5678|鈴木 花子|xxx |い  ぬ|
|------------------------------------------------------|

可能でしょうか。

この6種類のファイルは毎月中身のデータが変わるので、
恐らく1つマクロファイルを作成して、そこにファイル名を指定して、実行する形になりますでしょうか。
そうであればファイル名やPathを入れるファイルを作りますので、そこに書き込むマクロを教えていただけますでしょうか。
よろしくお願いします<(_ _)>

< 使用 Excel:unknown、使用 OS:unknown >


>可能でしょうか。
  たぶん。可能です。

>恐らく1つマクロファイルを作成して、そこにファイル名を指定して、実行する形になりますでしょうか。
  マクロ用のブック用意して他のブックを制御するってことですよね?
  そのような方法でよいとおもいます。

>そうであればファイル名やPathを入れるファイルを作りますので、そこに書き込むマクロを教えていただけますでしょうか。
  私は、作成依頼などの丸投げに対応するつもりがないので、他の回答者さんをおまちください。
  ※自力で作っていて、解らない部分があって詰まっているだけであれば、その部分の提示があれば、解る範囲でアドバイスすることは可能です。
(もこな2) 2018/03/13(火) 14:02


もこな2さん、返信ありがとうございます。
つまっているのは5と6です。セルをただ塗りつぶす方法はたくさんでてくるのですが、値と一致したら、という簡単そうなものがなかなかヒットしません。
罫線もただひくのは簡単なのですが、名前が同じものは一緒に囲うというのがなかなか、、

他は結構すぐわかりました。

Sub Sample1()

Rows(2).Insert 2行目に行を追加
Range(Columns(2), Columns(4), Columns(7), Columns(8), Columns(9)).Delete 列削除
Columns("A:E").EntireColumn.AutoFit 列幅自動調整
Range("A3:F100").Sort Key1:=Range("D4"), Order1:=xlAscending, Header:=xlYes ユーザー名昇順

ActiveWorkbook.SaveAs FileFormat:=xlNormal xlsxで保存

End Sub

xlsxで保存がxlsになるのではないかと不安はあります、。

2箇所ご教示いただけると助かります!よろしくお願いします。

(かりん58) 2018/03/13(火) 18:22


 こんばんは!
方法は色々あると思いますが、どちらも条件付き書式で出来ると思いますので
記録して加工してみました。
CSVなのでちょっと工夫が必要かもしれませんが、そこはお勉強して頂くとして
罫線とか色は調整してください。
では、では、
Option Explicit
Sub てすと()
    Range("A1:F6").FormatConditions.Delete
    Range("D1").Select
    With Range("A1:F6")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$D1<>$D2"
        With .FormatConditions(1).Borders(xlBottom)
            .LineStyle = xlContinuous
            .TintAndShade = 0
            .Weight = xlHairline
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
    Range("F1").Select
    With Range("F1:F6")
        .FormatConditions.Add Type:=xlExpression, Formula1:="=F1=""ねこ"""
        With .FormatConditions(2).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 12611584
            .TintAndShade = 0
        End With
        .FormatConditions.Add Type:=xlExpression, Formula1:="=F1=""いぬ"""
        With .FormatConditions(3).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    End With
End Sub
v(=∩_∩=)v
(SoulMan) 2018/03/13(火) 22:30

SoulManさん、ありがとうございます!

まず罫線からやっております。
いただいた内容編集で横線はひけました!

あとそれにたいして縦線(垂直線)をひきたいので以下を追加しました。

    Set r = ActiveSheet.UsedRange

    r.Borders(xlInsideVertical).LineStyle = xlContinuous
    r.Borders(xlInsideVertical).Weight = xlThin

そうすると、まず全体を囲う外枠線がひかされません。
あと3行目より下に文字がある範囲全て、という指定はできますでしょうか?

色はついたのですが、思ってた色と違うので模索中です。
罫線についてまずわかれば教えてください<(_ _)>
(かりん58) 2018/03/14(水) 12:56


 こんばんは!
 すみませんね 見逃すところでした。
 >そうすると、まず全体を囲う外枠線がひかされません。 

 周囲を囲うのは、BorderAround です。

 後、Borders の引数を省略すると全ての罫線を引くことが出来ますから、
全て引きたいときは、引数を省略した Borders で全ての罫線を引いた後に
固有の右や下の罫線を装飾するのが一般的だと思います。

 >あと3行目より下に文字がある範囲全て、という指定はできますでしょうか? 
 これは、実際のシートの運用にもよりますが、UsedRange を使っていらっしゃるので

 一番手っ取り早いのは、OffsetとResuzeで下に二つシフトすることかな?
Debug.Print r.Offset(2).Resize(r.Rows.Count - 2).Address

 次に、Range を使って UsedRange の一番左の列を所得して Row を 3 に限定するとか
Debug.Print Range(Cells(3, r.Cells(1).Column), Cells(r.Rows.Count, r.Columns.Count)).Address
 ですかね

 まぁ、色々と試してみてください。
 では、では、

 Option Explicit
Sub てすと()
Dim r As Range
Dim rr As Range
Set r = ActiveSheet.UsedRange
r.Borders.LineStyle = xlNone
r.BorderAround , xlThin, xlContinuous
r.Borders(xlInsideVertical).LineStyle = xlContinuous
r.Borders(xlInsideVertical).Weight = xlThin
Debug.Print r.Offset(2).Resize(r.Rows.Count - 2).Address
Debug.Print Range(Cells(3, r.Cells(1).Column), Cells(r.Rows.Count, r.Columns.Count)).Address
End Sub
v(=∩_∩=)v
(SoulMan) 2018/03/14(水) 19:37

 すみません

 ↓これは、
 Debug.Print Range(Cells(3, r.Cells(1).Column), Cells(r.Rows.Count, r.Columns.Count)).Address

 ↓これか
 Debug.Print Range(Cells(3, r.Column), Cells(r.Rows.Count, r.Column + r.Columns.Count - 1)).Address

 ↓これ
 Debug.Print Cells(3, r.Column).Resize(r.Rows.Count - 2, r.Columns.Count).Address

  ですね
v(=∩_∩=)v
(SoulMan) 2018/03/14(水) 20:34

私が花粉と戦ってるあいだに話がすすんでますが、

>ActiveWorkbook.SaveAs FileFormat:=xlNormal xlsxで保存
>xlsxで保存がxlsになるのではないかと不安はあります。
バージョンが書かれていないのでわかりませんが、Excel2007以降であれば
FileFormat:=xlWorkbookDefault に修正すればよいとおもいます。

罫線については、一度「マクロの記録」ボタンを押したうえで手動操作を行い、
どのような命令を使えばよいのか、Excel君に書いてもらうとよいと思いますす。そのうえで、
http://www.moug.net/tech/exvba/0050133.html
http://officetanaka.net/excel/vba/tips/tips51.htm
のようなところで調べてみるとわかるかと思います。

また、
>5.F列に項目名以外2種類の値が入っているので、「ねこ」という値は青色(R220、G230、B241)でセルを塗りつぶし、「いぬ」という値は赤色(R255、他0)でセルを塗りつぶす
がわからないということですが、

それでは単純に、
A1の値が「ねこ」だったときは、RGB(220,230,241)、「いぬ」だったときはRGB(255,0,0)で塗りつぶしする方法はわかりますか?
(もこな2) 2018/03/14(水) 22:05


SoulManさん、引き続きありがとうございます!確認してまたご返事します。

>もこな2さん
指定して色ぬり、ですが、調べて以下の書き方をやってみたのですが、コンパイルエラーになってしまいます。。。恐らく初歩的なミスかと思うのですが、まだ調査中です。
指定する文字は正しいと思うのですが。

Sub 色付け()

    Call SetBkColorSameStr("ねこ", RGB(220, 230, 241))
    Call SetBkColorSameStr("いぬ", RGB(255, 0, 0))
End Sub

Excel2013、Win7です。
Excel保存ありがとうございます!やってみます。
マクロの記録も使って、もう少し調べてみます。
(かりん58) 2018/03/15(木) 11:07


 ここのページのか?
https://vbabeginner.net/vba%E3%81%A7%E6%8C%87%E5%AE%9A%E6%96%87%E5%AD%97%E5%88%97%E3%81%8C%E3%81%82%E3%82%8B%E3%82%BB%E3%83%AB%E3%81%AB%E8%83%8C%E6%99%AF%E8%89%B2%E3%82%92%E8%A8%AD%E5%AE%9A%E3%81%99%E3%82%8B/
 で、そのページの上部に書かれている
 Sub SetBkColorSameStr(a_sFind, a_SetColor)
    〜
 End Sub
 のコードは記入しているのか?
(ねむねむ) 2018/03/15(木) 11:19

ねむねむさん、ありがとうございます。まさにその通りです。
使い方が間違えているのかと思うのですが、、、上の文書を入れてみても”Call SetBkColorSameStr”でエラーになってしまいます。

Callを書く場所が違うのでしょうか。

Sub 色塗り()

    Dim r As Range  '// 入力されているセル範囲
    Dim c As Range  '// 入力されているセル範囲のループ中の1セル

    Call SetBkColorSameStr("ねこ", RGB(220, 230, 241))
    Call SetBkColorSameStr("いぬ", RGB(255, 0, 0))

    Set r = ActiveSheet.UsedRange

    For Each c In r
        If (InStr(1, c.Value, a_sFind) > 0) Then
            c.Interior.Color = a_SetColor
        End If
    Next
End Sub

あとこのページ下のカスタマイズ方法にあるようにF列にのみこの条件を指定したいのですが、「Set r = Selection」でどのようにF列を指定すると良いのでしょうか?

教えてください<(_ _)>
(かりん58) 2018/03/15(木) 11:34


 Sub SetBkColorSameStr(a_sFind, a_SetColor)
    〜
 End Sub
 は標準モジュールに記述してあるか?

 あと、エラーに関することで質問がある場合、なんというエラーになったかも書いたほうがいい。
(ねむねむ) 2018/03/15(木) 15:29

2018/03/15(木) 11:07 の投稿へのレスです。

えっと、とりあえず、「A1」セルを単純に
 RGB(220, 230, 241) で塗りつぶす
 RGB(255, 0, 0) で塗りつぶす
マクロを考えて見てください。
※わからなければ「マクロの記録」です。

次に、下記のコメント部分(「」で囲んであるところ)に、どのような記述をすればよいか考えてみてください。
Sub Sample()

    Select Case Range("A1").Value
        Case Is = "ねこ"
            '「A1セルを青色に塗りつぶす」
        Case Is = "いぬ"
            '「A1セルを赤色に塗りつぶす」
        Case Else
            '「A1セルの塗りつぶしを解除する」
    End Select
End Sub
※わからなければ1つ前にもどって考えてみてください。
(もこな2) 2018/03/15(木) 15:52

ねむねむさん

こういう事ですか??

Sub SetBkColorSameStr(a_sFind, a_SetColor)

    Dim r As Range  '// 入力されているセル範囲
    Dim c As Range  '// 入力されているセル範囲のループ中の1セル

    Call SetBkColorSameStr("いぬ", RGB(220, 230, 241))
    Call SetBkColorSameStr("ねこ", RGB(255, 0, 0))

    Set r = ActiveSheet.UsedRange

    For Each c In r
        If (InStr(1, c.Value, a_sFind) > 0) Then
            c.Interior.Color = a_SetColor
        End If
    Next
End Sub

標準モジュールにこれを入力しても実行する事ができません。。マクロの一覧に出てこないといいますか。

(かりん58) 2018/03/15(木) 16:07


 手順。
 1. 参照ページの「使い方」の上にある

 '// 引数1:検索文字列
 '// 引数2:背景色
 Sub SetBkColorSameStr(a_sFind, a_SetColor)
    Dim r As Range  '// 入力されているセル範囲
    Dim c As Range  '// 入力されているセル範囲のループ中の1セル
     〜
 End Sub
 を標準モジュールに記述する。
(ねむねむ) 2018/03/15(木) 16:20

 2. 上記を記述することでSetBkColorSameStrが使えるようになるので実際に使いたい個所で
  Call SetBkColorSameStr(〜)
 を行う。

(ねむねむ) 2018/03/15(木) 16:23


コメント返信:

[ 一覧(最新更新順) ]


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