.エクセルVBAの条件分岐に関するコードに関して、
質問させていただきます。
シート1にある表(画像をご参照ください)に
おいて条件に合う方の行に入っている
「AM」「PM」という文字を
「出席」という文字に置き換えたいのです。
置き換える場所は、
別シート(画像:シート2)になります。
―――皆様にご教授いただきたいのは――――
【1】
シート1「顧客簿」において、
見学の列が「○」かつ退会の列が「(空欄)」である
ものを探すコードの書き方
【2】
シート2「カレンダー」において
上記【1】に該当する方が
いらっしゃる曜日を探すコード
例)シート1の佐藤さんは「見学が○かつ退会が空欄」
↓↓↓↓↓
佐藤さんは条件に合致
↓↓↓↓↓
佐藤さんは月曜と水曜に通っている
↓↓↓↓↓
シート2の月曜を探す
↓↓↓↓↓
シート2の佐藤さんの行の月曜の列に入っている
「AM」を「出席」に置き換え
↓↓↓↓↓
シート2の佐藤さんの行の水曜の列に入っている
「PM」を「出席」に置き換え
※※※※
シート2「カレンダー」の日付、曜日のセルには
date 関数を使用しており、
自動で月ごとに表示される使用です。
※※※※
【2】
また、300人以上のデータがある場合、
どのようにコードを書けば、
繰り返し条件を探す【1】の処理を実行することが
可能でしょうか?
【1】と【2】を実現する
コードをお教え願いたく存じます。
――――――――――――――――――
VBA初心者で質問の仕方も
適切な表現でなく、誠に申し訳ございません。
よろしくお願い申し上げます。
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
こんばんは!
一例です。
↓の画像で上側が元データのSheet1・下側がSheet2とします。
Sheet2の3行目は作業用の列として使用していますので、画像通りの配置にしてみてください。
>シート2「カレンダー」の日付、曜日のセルには
>date 関数を使用しており、
とありますが
画像ではSheet2のB4セル(セルの表示形式はユーザー定義から d としています)に
=IF(MONTH(DATE($A1,$A2,COLUMN(A1)))=$A2,DATE($A1,$A2,COLUMN(A1)),"")
B5セル(セルの表示形式はユーザー定義から aaa としています)に
=IF(B4="","",B4)
という数式を入れB4・B5セルを範囲指定 → B5セルのフィルハンドルで月末(31日)までのAF列までコピーしています。
(この数式でSheet2のA1・A2セルの数値を入れ替えるだけで自動で日付・曜日が変わります)
以上の下準備ができた上でのVBAでの一例です。
標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。
Sub Sample1() 'この行から
Dim i As Long, j As Long, k As Long, lastRow As Long
Dim c As Range, r As Range, wS As Worksheet
Set wS = Worksheets("Sheet2")
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS.Cells(4, "B"), wS.Cells(4, "AF")).Copy wS.Range("B3")
With Range(wS.Cells(3, "B"), wS.Cells(3, "AF"))
.Formula = "=TEXT(B4,""aaa"")"
.Value = .Value
End With
Range(wS.Cells(6, "B"), wS.Cells(lastRow, "AF")).ClearContents
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, "B") = "○" And .Cells(i, "C") = "" Then
For j = 4 To .Cells(1, Columns.Count).End(xlToLeft).Column
If .Cells(i, j) <> "" Then
Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
Set r = wS.Rows(3).Find(what:=.Cells(1, j), LookIn:=xlValues, lookat:=xlWhole)
For k = r.Column To 32 Step 7
If wS.Cells(3, k) <> "" Then
wS.Cells(c.Row, k) = "出席"
End If
Next k
End If
Next j
End If
Next i
End With
wS.Rows(3).Clear
End Sub 'この行まで
こんな感じではどうでしょうか?m(_ _)m
この回答への補足
早々の返信、
誠にありがとうございます。
ただ、
================
コードの下から9行目にある
「End If」の部分で
エラー表示が出てしまい、
動きません。
================
解決策、あるいは他の策を
お教え願いますでしょうか?
どうかよろしくお願い申し上げます。
No.2
- 回答日時:
Alt+F11でVBEを開き、挿入から標準モジュールを挿入して下記のVBAコードを貼り付けてください。
VBEを閉じてからAlt+F8または表示→マクロより「Action」を選び実行してください。
シート名を「顧客簿」と「カレンダー」であるとして作成しています。
異なる場合はコード内の以下の箇所を変更してください。
'シート名の設定
Set mySt(0) = Sheets("顧客簿")
Set mySt(1) = Sheets("カレンダー")
>また、300人以上のデータがある場合、どのようにコードを書けば、
>繰り返し条件を探す【1】の処理を実行することが可能でしょうか?
該当の表が下に同じ様式で連なっているのであれば、
表を増やすことで対応できます。(添付画像参照)
ただし、同姓同名である場合はどう処理するのでしょうか?
現在のコードでは名前は重複しないものとして作成しています。
■VBAコード
Sub Action()
'型宣言
Dim mySt(1) As Worksheet
Dim i As Long
Dim j As Integer
Dim myTar As Range
Dim bkRng As Range
Dim nxRng As Range
'シート名の設定
Set mySt(0) = Sheets("顧客簿")
Set mySt(1) = Sheets("カレンダー")
'実処理
With mySt(0)
'2行目~A列の最終行まで繰り返し処理
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
'【1】対象行iの列Bが○で列Cが空欄の場合の処理
If .Range("B" & i) = "○" And Len(.Range("C" & i)) = 0 Then
'カレンダーシートの名前を検索
Set myTar = mySt(1).Columns("A").Find(.Range("A" & i))
'4列目(D)~8列目(H)まで繰り返し処理
For j = 4 To 8
'対象のセルが空白でなければ(AM、PMが入っていれば)処理
If Len(.Cells(i, j)) > 0 Then
'ユーザー定義関数で処理し、返ったセルに出席を入力
mySearch(mySt(1), 2, myTar.Row, .Cells(1, j)) = "出席"
End If
Next j
End If
Next i
End With
End Sub
'行方向に検索して一致したオフセットセルを返すユーザー定義関数
Function mySearch(mySt As Worksheet, srow As Long, trow As Long, word As String) As Range
Dim hit As Long
On Error GoTo era
With mySt
Do
hit = WorksheetFunction.Match(word, .Range(.Cells(srow, hit + 1), .Cells(srow, Columns.Count)), 0) + hit
If mySearch Is Nothing Then
Set mySearch = .Cells(trow, hit)
Else
Set mySearch = Union(mySearch, .Cells(trow, hit))
End If
Loop
End With
Exit Function
era:
End Function
No.3
- 回答日時:
No.1です。
>コードの下から9行目にある
>「End If」の部分で
>エラー表示が出てしまい、
>動きません。
すなわち
>If wS.Cells(3, k) <> "" Then
>wS.Cells(c.Row, k) = "出席"
の部分でのエラーだと思われます。
一番怪しいのは「小の月」の場合など31日のセルが空白になっていない。
という原因が考えられます。
前回Sheet2の4行目・5行目の数式を投稿したのは
大の月・小の月に対応するためのものです。
今一度4行目の数式を見直して、
(1)シリアル値になっているか?
(2)小の月の月末部分が空白になっているかどうか確認してみてください。
(5行目は今回利用していませんので、気にしなくて大丈夫です)
今考えられる原因としてはこの程度ですが・・・
これでもダメなら、
列方向の「日付」「曜日」のセルにはどんな数式を入れているか教えてください。
(お手元のExcelのレイアウトも判ればより的確なアドバイスができると思います)
それに基づいて、もう一度他の方法を考えてみます。m(_ _)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) EXCEL VBA 単語置き換え について質問です ブック名 ぶぶぶ シート名 ししし セル V3〜 3 2023/03/08 01:41
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- Excel(エクセル) エクセルで”入力シート”の文字書式の変更を”出力シート”で同じ文字書式で印刷したいです。VBA希望 4 2023/04/24 11:07
- Visual Basic(VBA) 【VBA】Excelで罫線を引きたい 3 2022/07/14 12:04
- Visual Basic(VBA) ExcelのVBAを使い、複数シートの同一箇所を、同一条件にて一括でソルバーを回す方法について 1 2022/04/23 11:49
- Visual Basic(VBA) エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい 9 2022/08/24 13:23
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Visual Basic(VBA) 祝日を除いた月曜から土曜までの1週間分の日付行を選択し、別シートへカットアンドペーストしたい 13 2023/07/13 22:46
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Excel(エクセル) エクセルでカレンダーを作りたい 5 2023/05/16 07:32
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの「0」だけ非表示、小数...
-
日付が未入力の際はゼロか、空...
-
エクセルで1月0日と表示される!!
-
エクセルで条件に一致したセル...
-
Rangeメソッドは失敗しました。...
-
(Excel)あるセルに文字を入力...
-
複数シートの同じセル内容を1シ...
-
別シートのセルを絶対参照にする
-
Excelシートの保護時にデータの...
-
エクセルの文字
-
Excelにて、カタカナだけのセル...
-
Excelで複数シートの選択セルを...
-
エクセルで20万行あるシート...
-
エクセルで、加筆修正したセル...
-
エクセルのルビがついたセルを...
-
エクセルで別シートからの最大...
-
シート参照で変数を使いたい(EX...
-
EXCELマクロで、シート間でのコ...
-
Aというブックの1というシート...
-
excelでハイパーリンクになって...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの「0」だけ非表示、小数...
-
日付が未入力の際はゼロか、空...
-
エクセルで条件に一致したセル...
-
エクセルで1月0日と表示される!!
-
(Excel)あるセルに文字を入力...
-
別シートのセルを絶対参照にする
-
Rangeメソッドは失敗しました。...
-
Excelシートの保護時にデータの...
-
複数シートの同じセル内容を1シ...
-
エクセルで、加筆修正したセル...
-
シート参照で変数を使いたい(EX...
-
エクセルで複写のように自動入...
-
Excelで複数シートの選択セルを...
-
INDIRECTを使わず excelで複数...
-
ExcelでTODAY関数を更新させな...
-
式の説明をお願いします。
-
excelでハイパーリンクになって...
-
エクセルのルビがついたセルを...
-
Excelでスクロールすると文字が...
-
エクセル ハイパーリンクで画像...
おすすめ情報