[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数のファイルに対して同じ処理を実行したい』（かりん５８）
こんにちわ。よろしくお願いします。
ファイルの中身の項目が同じものが６種類あります。
AからK列の２行目に項目名があり、その下に値が入っています。行数は色々です。
これらのファイルに対して、以下の処理を実施するマクロを考えてます。
１．2行目に空白の行を追加する
２．B列、D列、G列、H列、I列を列ごと削除する
３．列幅を全て文字が表示されるよう整える(手動だと罫線の上ダブルクリックして表示される程度でいいです。)
４．D列(２．の削除後)3行目に『ユーザー名』という項目があるので、昇順で並び替えをする
５．F列に項目名以外2種類の値が入っているので、「ねこ」という値は青色(R220、G230、B241)でセルを塗りつぶし、「いぬ」という値は赤色(R255、他0)でセルを塗りつぶす
６．表に罫線をつける、細線実線で統一、
列横は全て罫線、行の罫線はD列のユーザー名が同じものは同じ枠で囲う
７．ファイルはcsvなので、同じファイル名で拡張子.xlsxで別ファイルとして保存する。(同じディレクトリで良いです)
A B C D E F
｜------------------------------------------------------｜
｜場所｜時刻｜ユーザID ｜ユーザー名 ｜移動先｜移動元｜
｜------------------------------------------------------｜
｜ｘｘ｜ｍｄ｜１２３４｜佐藤 学ぶ｜ｘｘｘ ｜ね こ｜
｜ｘｘ｜ｍｄ｜１２３４｜佐藤 学ぶ｜ｘｘｘ ｜い ぬ｜
｜ｘｘ｜ｍｄ｜１２３４｜佐藤 学ぶ｜ｘｘｘ ｜ね こ｜
｜------------------------------------------------------｜
｜ｘｘ｜ｍｄ｜５６７８｜鈴木 花子｜ｘｘｘ ｜ね こ｜
｜ｘｘ｜ｍｄ｜５６７８｜鈴木 花子｜ｘｘｘ ｜い ぬ｜
｜------------------------------------------------------｜
可能でしょうか。
この６種類のファイルは毎月中身のデータが変わるので、
恐らく１つマクロファイルを作成して、そこにファイル名を指定して、実行する形になりますでしょうか。
そうであればファイル名やPathを入れるファイルを作りますので、そこに書き込むマクロを教えていただけますでしょうか。
よろしくお願いします<(_ _)>
＜ 使用 Excel：unknown、使用 OS：unknown ＞
＞恐らく１つマクロファイルを作成して、そこにファイル名を指定して、実行する形になりますでしょうか。
マクロ用のブック用意して他のブックを制御するってことですよね？
そのような方法でよいとおもいます。
＞そうであればファイル名やPathを入れるファイルを作りますので、そこに書き込むマクロを教えていただけますでしょうか。
私は、作成依頼などの丸投げに対応するつもりがないので、他の回答者さんをおまちください。
※自力で作っていて、解らない部分があって詰まっているだけであれば、その部分の提示があれば、解る範囲でアドバイスすることは可能です。
（もこな２） 2018/03/13(火) 14:02
他は結構すぐわかりました。
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箇所ご教示いただけると助かります！よろしくお願いします。
（かりん５８） 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
まず罫線からやっております。
いただいた内容編集で横線はひけました！
あとそれにたいして縦線(垂直線)をひきたいので以下を追加しました。
Set r = ActiveSheet.UsedRange
r.Borders(xlInsideVertical).LineStyle = xlContinuous
r.Borders(xlInsideVertical).Weight = xlThin
そうすると、まず全体を囲う外枠線がひかされません。
あと3行目より下に文字がある範囲全て、という指定はできますでしょうか？
色はついたのですが、思ってた色と違うので模索中です。
罫線についてまずわかれば教えてください<(_ _)>
（かりん５８） 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
のようなところで調べてみるとわかるかと思います。
また、
＞５．F列に項目名以外2種類の値が入っているので、「ねこ」という値は青色(R220、G230、B241)でセルを塗りつぶし、「いぬ」という値は赤色(R255、他0)でセルを塗りつぶす
がわからないということですが、
それでは単純に、
A1の値が「ねこ」だったときは、RGB(220,230,241)、「いぬ」だったときはRGB(255,0,0)で塗りつぶしする方法はわかりますか？
（もこな２） 2018/03/14(水) 22:05
＞もこな2さん
指定して色ぬり、ですが、調べて以下の書き方をやってみたのですが、コンパイルエラーになってしまいます。。。恐らく初歩的なミスかと思うのですが、まだ調査中です。
指定する文字は正しいと思うのですが。
Sub 色付け()
Call SetBkColorSameStr("ねこ", RGB(220, 230, 241))
Call SetBkColorSameStr("いぬ", RGB(255, 0, 0))
End Sub
Excel2013、Win7です。
Excel保存ありがとうございます！やってみます。
マクロの記録も使って、もう少し調べてみます。
（かりん５８） 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を書く場所が違うのでしょうか。
Sub 色塗り()
Dim r As Range '// 入力されているセル範囲
Dim c As Range '// 入力されているセル範囲のループ中の１セル
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列を指定すると良いのでしょうか？
教えてください<(_ _)>
（かりん５８） 2018/03/15(木) 11:34
Sub SetBkColorSameStr(a_sFind, a_SetColor) 〜 End Sub は標準モジュールに記述してあるか？
あと、エラーに関することで質問がある場合、なんというエラーになったかも書いたほうがいい。 （ねむねむ） 2018/03/15(木) 15:29
えっと、とりあえず、「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つ前にもどって考えてみてください。
（もこな２） 2018/03/15(木) 15:52
こういう事ですか？？
Sub SetBkColorSameStr(a_sFind, a_SetColor)
Dim r As Range '// 入力されているセル範囲
Dim c As Range '// 入力されているセル範囲のループ中の１セル
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
標準モジュールにこれを入力しても実行する事ができません。。マクロの一覧に出てこないといいますか。
（かりん５８） 2018/03/15(木) 16:07
手順。 1. 参照ページの「使い方」の上にある
'// 引数1：検索文字列
'// 引数2：背景色
Sub SetBkColorSameStr(a_sFind, a_SetColor)
Dim r As Range '// 入力されているセル範囲
Dim c As Range '// 入力されているセル範囲のループ中の１セル
〜
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.