Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

31 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81868】Re:オープンオフィスですが

山内 - 21/8/3(火) 14:17 -


	引用なし

	パスワード

全角スペース使うのやめませんか？

・ツリー全体表示


	【81867】オープンオフィスですが

理学療法士 - 21/8/2(月) 22:15 -


	引用なし

	パスワード

オープンオフィスでマクロを作成しようとし
以下のものを入力すると、ランタイムエラー91が
　
Function CellCountByCol(targetRng As Range, CellColor As Range) As Long
　 Dim r As Range
Application.Volatile
CellCountByCol = 0

For Each r In targetRng　←ここ
　If r.Interior.Color = CellColor.Interior.Color Then
　　CellCountByCol = CellCountByCol + 1
　End If
Next r
End Function

に出てしまいます。

修正したいのですがわかりません。
指導よろしくお願いいたします。

・ツリー全体表示


	【81866】Re:環境依存文字があると関数が動かない...

山内 - 21/7/29(木) 16:32 -


	引用なし

	パスワード

半角カナは半角だけど例外的にセーフってことですか？
それならS-JISにあるかどうかとか半角カナが含まれるかとか判定する関数を作る必要があるんじゃないでしょうか。
例外がどれだけあるのかこちらからはわからないのではっきりとした回答はできないです。

・ツリー全体表示


	【81865】Re:環境依存文字があると関数が動かない...

すず - 21/7/29(木) 15:56 -


	引用なし

	パスワード

▼山内さん：
>vbFromUnicodeはS-JISに変換するためS-JISに変換できない文字は正常に動作しません
>if 対象文字列 <> Strconv(対象文字列,vbWide) thenとかじゃダメでしょうか

vbwideだと確かにerrorではなくなりますが半角カナでもerrorではなくなってしまいます。。。( ;∀;)

・ツリー全体表示


	【81864】Re:環境依存文字があると関数が動かない...

山内 - 21/7/29(木) 10:12 -


	引用なし

	パスワード

vbFromUnicodeはS-JISに変換するためS-JISに変換できない文字は正常に動作しません
if 対象文字列 <> Strconv(対象文字列,vbWide) thenとかじゃダメでしょうか

・ツリー全体表示


	【81863】環境依存文字があると関数が動かないです

すず - 21/7/28(水) 16:44 -


	引用なし

	パスワード

セルに半角があるかチェックするために関数をEXCEL VBAで使っていますが、
環境依存文字（㊑とか）が入ると「全て全角ではありません」になってしまいます。
環境依存文字って全角ですよね？
環境文字列があると「vbFromUnicode」って使えないのでしょうか？
他にチェックする方法がありましたらお願いします。
基本、掲載名には環境依存文字が入るのですが半角全角チェックはVBAでしたいです。
下記が使っている式です。ご教授お願いします！！！

If LenB(対象文字列) > LenB(StrConv(対象文字列, vbFromUnicode)) Then
　　　　Range(対象文字列).Interior.ColorIndex = 22
　　　　MsgBox "■掲載情報" & f & vbCrLf & "新" & Range("E16")
& "が" & vbCrLf & "すべて全角ではありません。"
, vbCritical, "必須項目エラーあり"

・ツリー全体表示


	【81862】SharePointのリストへのADO接続

とも - 21/7/22(木) 1:33 -


	引用なし

	パスワード

※エクセルの学校（[20210722010531]）とのマルチポスト投稿になります。ご了承ください

半日ほど悩んだのですが解決方法が見つからなかったので、こちらで質問をさせていただきます。
以下のコードでSharePointのリストにADO接続したいのですが、※1DELETE/※2UPDATE　は実行できるのですが
※3INSERTを実行するとエラー【フィールド'名前'は更新できません。フィールドが更新可能ではありません。】となります。

SQLの記述を色々と試したのですがダメでした。
（SharePointの問題かとも思ったのですが原因は分からず）
皆様にお知恵をいただければと思い投稿させてもらいました。
宜しくお願いします。

Sub ボタン1_Click()
　　Dim adoCn As Object
　　Dim strSQL As String
　　Set adoCn = CreateObject("ADODB.Connection")
　　adoCn.Open"Provider=Microsoft.ACE.OLEDB.12.0;WSS;_
　　IMEX=2;RetrieveIds=Yes;DATABASE=シェアポイントURL;LIST=テストリスト;"
　　※1 strSQL = "DELETE FROM テストリスト WHERE 名前 = ""殿馬"";"
　　※2 strSQL = "UPDATE テストリスト SET 名前 = ""さとなか"" WHERE 名前 = ""里中"";"
　　※3 strSQL = "INSERT INTO テストリスト(名前) VALUES(""岩鬼"");"
　　adoCn.Execute strSQL
　　adoCn.Close
　　Set adoCn = Nothing
End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

・ツリー全体表示


	【81861】Re:範囲指定につきまして

TD&S - 21/7/5(月) 18:08 -


	引用なし

	パスワード

▼まりさん：こんばんは、
どのくらい遅いか見当がつかないので、EXCEL画面の画面表示を停止する命令を入れてみてください。

Private Sub CommandButton1_Click()
　 Application.ScreenUpdating = False　'<--先頭行に追加　画面表示停止

　 Application.ScreenUpdating = true　'<--最終行に追加　画面表示開始
End Sub

Private Sub CommandButton2_Click()
　 Application.ScreenUpdating = False　'<--先頭行に追加

　 Application.ScreenUpdating = true　'<--最終行に追加
End Sub

・ツリー全体表示


	【81860】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/7/5(月) 14:35 -


	引用なし

	パスワード

>１つめは　
>　
>>　　ws2.Range("A5:BD" & iLast * 6 + 4).ClearContents
>
>マクロの実行を行うとこちらの式でエラーが出ました。
>範囲をA５：BD３５と指定をしても同じようにエラーが出ます。
>何か解決策はありますでしょうか。

元のコードからselectionを省略しているだけなので原因不明です。
エラーメッセージの内容を教えてください。

>２つめに
>
>>　　　　'If (ws1.Cells(a, 4).Value = "カット" Or ws1.Cells(a, 4).Value = "カラー") _
>>　　　　And ws1.Cells(a, 14).Value = "予約可" Then
>>　　　　'よくわからないのでとりあえずコメントアウト
>>　　　　　　For j = 1 To 2
>>　　　　　　　　For i = 1 To iLast
>>　　　　　　　　　　Set rng = ws2.Cells(i * 6 - 1, j * 4 - 3 + clmnplus)
>>　　　　　　　　　　If rng.Value = "" Then
>>　　　　　　　　　　　　rng.Value = ws1.Cells(a, 6).Value
>>　　　　　　　　　　　　ws2.Cells(rng.Row + 2, rng.Column + 3).Value = ws1.Cells(a, 4).Value
>>　　　　　　　　　　　　GoTo 脱出
>>　　　　　　　　　　End If
>>　　　　　　　　Next
>>　　　　　　Next
>>　　　　'End If
>
>こちらの条件式で実行をした場合に”トリートメント”予約の方も出てきました。
>作成いただいた表はカットとカラーを抽出したいのですが、もとのCSVデータには（a,4)にトリートメントの方も含まれております。どのようにすれば指定できるのでしょうか。

カットやカラー、トリートメントがどういう条件で分けるのか不明なため条件を時間だけに絞ってほかはコメントアウトしているからです。
コウさんのコードでわかる条件は
１．カットもしくはカラーである。１２時である。予約可である。
２．カットもしくはカラーである。１２時である。要確認である。
３．カラーもしくはトリートメントである。１２時ではない。
この３つだけです。
回答者からすると「じゃぁトリートメントで１２時のときは？カットで１２時以外のときは？」となるわけです。
条件分けするとき（特に自分以外がコードを見る必要がある時）は条件を漏れなく書きましょう。

>最後に同じ時間帯の枠（例えば９;１５の枠の中）の中で、
>同じ方が繰り返し入ってきました。
>この繰り返しを止める方法はございますでしょうか。
>
>ご面倒ばかりおかけして申し訳ございません。
>ご指導のほどよろしくお願いします。

同じ人が繰り返し入る場合はつまりws1に重複したデータが複数行入っているということです。
重複したデータを削除してから実行してください。

・ツリー全体表示


	【81858】Re:次の列に続けて同じ処理を繰り返す方法

VBA超初心者コウ

- 21/7/3(土) 19:00 -


	引用なし

	パスワード

山内　様

お世話になっております。
拙い説明の中でとても丁寧にご指導くださいましてありがとうございます。
初心者にも大変わかりやすい内容で助かります。
ご察しの通りws1.Cells(1,1)には担当者の名前が入ります。
しかし、担当ごとに条件はございません。

また、厚かましくて恐縮ではございますが、いくつか質問をさせてください。

１つめは　
　
>　　ws2.Range("A5:BD" & iLast * 6 + 4).ClearContents

マクロの実行を行うとこちらの式でエラーが出ました。
範囲をA５：BD３５と指定をしても同じようにエラーが出ます。
何か解決策はありますでしょうか。

２つめに

>　　　　'If (ws1.Cells(a, 4).Value = "カット" Or ws1.Cells(a, 4).Value = "カラー") _
>　　　　And ws1.Cells(a, 14).Value = "予約可" Then
>　　　　'よくわからないのでとりあえずコメントアウト
>　　　　　　For j = 1 To 2
>　　　　　　　　For i = 1 To iLast
>　　　　　　　　　　Set rng = ws2.Cells(i * 6 - 1, j * 4 - 3 + clmnplus)
>　　　　　　　　　　If rng.Value = "" Then
>　　　　　　　　　　　　rng.Value = ws1.Cells(a, 6).Value
>　　　　　　　　　　　　ws2.Cells(rng.Row + 2, rng.Column + 3).Value = ws1.Cells(a, 4).Value
>　　　　　　　　　　　　GoTo 脱出
>　　　　　　　　　　End If
>　　　　　　　　Next
>　　　　　　Next
>　　　　'End If

こちらの条件式で実行をした場合に”トリートメント”予約の方も出てきました。
作成いただいた表はカットとカラーを抽出したいのですが、もとのCSVデータには（a,4)にトリートメントの方も含まれております。どのようにすれば指定できるのでしょうか。

最後に同じ時間帯の枠（例えば９;１５の枠の中）の中で、
同じ方が繰り返し入ってきました。
この繰り返しを止める方法はございますでしょうか。

ご面倒ばかりおかけして申し訳ございません。
ご指導のほどよろしくお願いします。

・ツリー全体表示


	【81857】範囲指定につきまして

まり - 21/7/3(土) 15:30 -


	引用なし

	パスワード

はじめまして。VBA初心者です。
横列にフィルタ処理をかけたく、検索していたら下記のコードを見つけたのでテストをしてみましたが、実行を押すと処理がとても遅いので「範囲を絞る」ということを試してみたいのですが
C4～ZZ100の範囲内で検索処理をしたい。といった場合には下記のコードにどのように追記すればよろしいでしょうか？

Dim rowno, colno As Integer

'=================================================
'フィルタ処理
'=================================================
Private Sub CommandButton1_Click()
　　Dim colAlfa, compData As String
　
　　With UserForm1.ListBox1
　　　　If .ListIndex < 0 Then
　　　　　　.ListIndex = 0
　　　　End If
　　　
　　　　selectedvalue = .List(.ListIndex, 0)
　　　　For i = colno To Columns.Count
　　　　　　nowcol = Cells(1, i).Address(True, False)
　　　　　　colAlfa = Left(nowcol, InStr(nowcol, "$") - 1)
　　　　　
　　　　　　If Columns(colAlfa).Hidden = False Then
　　　　　　　　If TypeName(Cells(rowno, i).Value) = "Integer" Then
　　　　　　　　　　compData = Trim(Str(Cells(rowno, i).Value))
　　　　　　　　Else
　　　　　　　　　　compData = Cells(rowno, i).Value
　　　　　　　　End If
　　　　　　　　If compData = selectedvalue Then
　　　　　　　　　　Columns(colAlfa).Hidden = False
　　　　　　　　Else
　　　　　　　　　　Columns(colAlfa).Hidden = True
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　End With
　　Unload UserForm1
End Sub

'=================================================
'クリア処理
'=================================================
Private Sub CommandButton2_Click()
　　Dim colAlfa As String
　
　　For i = 1 To Columns.Count
　　　　nowcol = Cells(1, i).Address(True, False)
　　　　colAlfa = Left(nowcol, InStr(nowcol, "$") - 1)
　　　　Columns(colAlfa).Hidden = False
　　Next i
　
　　Unload UserForm1
　
End Sub
'=================================================
'初期化処理
'=================================================
Private Sub UserForm_Initialize()
　　'選択行
　　rowno = ActiveCell.Row
　　'初期カラム
　　colno = ActiveCell.Column + 1
　
　　'リスト作成
　　For i = colno To Columns.Count
　　　　If UserForm1.ListBox1.ListCount = 0 Then
　　　　　　UserForm1.ListBox1.AddItem Cells(rowno, i).Value
　　　　Else
　　　　　　flg = False
　　　　　　For j = 0 To UserForm1.ListBox1.ListCount - 1
　　　　　　　　If Cells(rowno, i).Value = UserForm1.ListBox1.List(j) Then
　　　　　　　　　　flg = True
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next
　　　　　　If flg = False Then UserForm1.ListBox1.AddItem Cells(rowno, i).Value
　　　　End If
　　Next i
　
End Sub

・ツリー全体表示


	【81856】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/7/2(金) 17:18 -


	引用なし

	パスワード

とりあえず作ってみましたがカットやカラー、トリートメント
または予約可、要確認はどういう法則で並べていくのかよくわからないです。
A1セルが多分担当者の名前とかなんだろうと思いますが担当者によって条件が違うんでしょうか。

Sub 時間割作成成分()
　　Application.ScreenUpdating = False
　　
　　Dim ws1 As Worksheet
　　Set ws1 = Worksheets("CSVデータ取得")
　　Dim ws2 As Worksheet
　　Set ws2 = Worksheets("表")

　　Dim a As Long
　　Dim i As Long 'for行
　　Dim j As Long 'for列
　　Dim iLast As Long: iLast = 5　 '1以上
　　Dim jLast As Long
　　Dim rng As Range
　　Dim clmnplus As Long
　　
　　ws2.Range("A5:BD" & iLast * 6 + 4).ClearContents
　　ws2.Cells(1, 1) = ws1.Cells(2, 11)
　　
　　For a = 2 To 80
　　　　Select Case ws1.Cells(a, 12).Value
　　　　Case "0915" '"915"かも？
　　　　　　clmnplus = 0
　　　　Case "1000"
　　　　　　clmnplus = 8
　　　　Case "1200"
　　　　　　clmnplus = 16
　　　　Case "1300"
　　　　　　clmnplus = 31
　　　　Case "1500"
　　　　　　clmnplus = 39
　　　　Case "1600"
　　　　　　clmnplus = 47
　　　　Case Else
　　　　　　GoTo 脱出
　　　　End Select
　　　　'If (ws1.Cells(a, 4).Value = "カット" Or ws1.Cells(a, 4).Value = "カラー") _
　　　　And ws1.Cells(a, 14).Value = "予約可" Then
　　　　'よくわからないのでとりあえずコメントアウト
　　　　　　For j = 1 To 2
　　　　　　　　For i = 1 To iLast
　　　　　　　　　　Set rng = ws2.Cells(i * 6 - 1, j * 4 - 3 + clmnplus)
　　　　　　　　　　If rng.Value = "" Then
　　　　　　　　　　　　rng.Value = ws1.Cells(a, 6).Value
　　　　　　　　　　　　ws2.Cells(rng.Row + 2, rng.Column + 3).Value = ws1.Cells(a, 4).Value
　　　　　　　　　　　　GoTo 脱出
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Next
　　　　'End If
脱出:
　　Next
　　
　　Application.ScreenUpdating = True
　　
End Sub

・ツリー全体表示


	【81855】Re:次の列に続けて同じ処理を繰り返す方法

VBA超初心者コウ

- 21/7/2(金) 15:39 -


	引用なし

	パスワード

山内様

ご丁寧にお答えをいただきましてありがとうございます。
予約表のシートがかなり複雑に感じまして簡略化してお伝えしておりました。
ご不便をおかけいたしまして申し訳ございません。

一人に対しての予約枠は6行×4列です。（A5：D10）
予約表（ｗｓ2）は以下A1に日付が入ります。
3行目カットとカラーの予約用の時間枠を入力しております。
A3：H4（セル結合）9：15　（A5:D10/E5:H10で2列が9：15の予約です。）
I3：P4　　　　　　10：00
Q3：X4　　　　　　12：00
AF3:AM4　　　　　　13：00
AN3：AU4　　　　　15：00
AV3：BC4　　　　　16：00

2行ごとにセル結合を行っています。（実質3行）
予約者の名前は5行目に入ります。
A5：C6(セル結合）に予約者名
以下6行ごとにお名前が入ります。
（A11・A17・A23・A29）

予約の種類（カットかカラーか）D7:D8（セル結合）に入れます。
以下6行ごとに予約種類が入ります。
（D7・D13・D17・D23・D29）

書き込みができるように空白が多いようにしています。

この予約表がA5：BC34までで60枠できます。

ご面倒をおかけしておりました↓↓↓

a = 2 to 80で最高79個予約が入っている状態だと推測できるんですが

ElseIf ws2.Cells(29, 1) <> "" Then
　ws2.Cells(35, 1) = ""
　ws2.Cells(37, 1) = ""
End If
=""で空白にしてる部分全般に言えることなのですがなぜ空白にするのでしょうか
予約の上限なのでしょうか？
上限になったらExit Forなどでループから抜けるべきではないでしょうか

こちらは、35行目より下にもお名前が入っていたため、
それを表示しないように入力を入れておりました。

最高で79個予約が入るというご解釈で間違いございません。
”1200”は12：00の枠という事になります。
次の列に処理を続けたかったのですが
処理が下にしか続けることが出来なかったため、
9：15の処理を列ごとに分けて
2列目は毎回、変数aの隣の5名を除いた数という意味で　a+5という形で入力していました。

exit for を使用してもうまく機能せず、loopもうまく隣に続きませんでした。

もしこれらを使用してもっと簡単になるのでありましたら
ぜひお教えいただけますと幸いです。
ご面倒をおかけいたしますがよろしくお願い申し上げます。
ありがとうございます。

・ツリー全体表示


	【81854】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/6/30(水) 17:22 -


	引用なし

	パスワード

最初にA:Bに12時、C:Dに13時とおっしゃっていましたが
コードを見る限りA:Dが12時前半、E:Hが12時後半といった感じなのでしょうか？

ws1.Cells(a, 12) = "1200"の"1200"というのは12:00ということでしょうか？

a = 2 to 80で最高79個予約が入っている状態だと推測できるんですが
ElseIf ws2.Cells(29, 1) <> "" Then
　ws2.Cells(35, 1) = ""
　ws2.Cells(37, 1) = ""
End If
=""で空白にしてる部分全般に言えることなのですがなぜ空白にするのでしょうか
予約の上限なのでしょうか？
上限になったらExit Forなどでループから抜けるべきではないでしょうか

E:H列に書き込んでいく条件が
If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
とA:D列に書き込んでいく条件と全く同じなので二重予約になると思います。
正しい動作になのでしょうか？
間違った動作ならExit Forで抜けたところから再開するよう
For b = a to 80
など工夫が必要かもしれません。

Range("E29", "H34") = ""
などワークシートの指定がない箇所が複数あります。
こちらからはどのシートなのかわからないので指摘のしようがありません。

完成図が想像でしかわからないのでレイアウトを示してくれるともう少しはっきりとした回答ができるかもしれません。

・ツリー全体表示


	【81853】Re:次の列に続けて同じ処理を繰り返す方法

VBA初心者コウ - 21/6/30(水) 11:43 -


	引用なし

	パスワード

山内　様

丁寧なご回答をいただきまして誠にありがとうございます。
前任が作ったVBAを引き継いだため、どの辺りがうまく機能していないのかが
分からず…。一つ一つお答えをいただきまして大変助かります。

コードを以下に書き込み致しますので、
よろしければ見ていただけますと幸いです。
（初めから書き込めばよかったですね…。すみません。）
お付き合いいただきありがとうございます。
よろしくお願い申し上げます。

Sub 時間割作成成分()
　　ScreenUpdating = False
　　　　Range("A5:BD34").Select
　　　　Selection.ClearContents
　　Dim ws1 As Worksheet
　　Set ws1 = Worksheets("CSVデータ取得")
　　Dim ws2 As Worksheet
　　Set ws2 = Worksheets("表")
　　ws2.Cells(1, 1) = ws1.Cells(2, 11)
　　
　　Dim a As Integer
　　
　　Dim k As Integer
　　k = 5
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws2.Cells(29, 1) <> "" Then
　　　　ws2.Cells(35, 1) = ""
　　　　ws2.Cells(37, 1) = ""
　　　　End If
　　　　Next a
　　　
　　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(k, 1) = ws1.Cells(a, 6)
　　　　ws2.Cells(k + 2, 4) = ws1.Cells(a, 4)
　　　　k = k + 6
　　　　ElseIf ws2.Cells(29, 1) <> "" Then
　　　　ws2.Cells(35, 1) = ""
　　　　ws2.Cells(37, 1) = ""
　　　　End If
　　　　Next a
　　　
　　'12:00-2
　　
　　Dim h As Integer
　　h = 5
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "予約可" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws2.Cells(23, 5) <> "" Then
　　　　Range("E29", "H34") = ""
　　　　End If
　　　　Next
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws1.Cells(a, 4) = "カット" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 4) = "カラー" And ws1.Cells(a, 12) = "1200" And ws1.Cells(a, 14) = "要確認" Then
　　　　ws2.Cells(h, 5) = ws1.Cells(a + 5, 6)
　　　　ws2.Cells(h + 2, 8) = ws1.Cells(a + 5, 4)
　　　　h = h + 6
　　　　ElseIf ws2.Cells(23, 5) <> "" Then
　　　　Range("E29", "H34") = ""
　　　　End If
　　　　Next
　　
　　
　　　　For a = 2 To 80 Step 1
　　　　If ws2.Cells(5, 1) = "" Or ws2.Cells(11, 1) = "" Or ws2.Cells(17, 1) = "" Or ws2.Cells(23, 1) = "" _
　　　　Or ws2.Cells(29, 1) = "" Then
　　　　Range("E5", "H34") = ""
　　　　ElseIf ws1.Cells(a, 12) <> "1200" And ws1.Cells(a + 5, 4) = "カラー" Then
　　　　ws2.Cells(h + 2, 5) = ""
　　　　ws2.Cells(h, 8) = ""
　　　　h = h + 6
　　　　ElseIf ws1.Cells(a, 12) <> "1200" And ws1.Cells(a + 5, 4) = "トリートメント" Then
　　　　ws2.Cells(h + 2, 5) = ""
　　　　ws2.Cells(h, 8) = ""
　　　　h = h + 6
　　　
　　　　End If
　　　　Next
　　　　

・・・という風になっております。
12：00・13：30・15：00と続くため、コードはコピー＆ペーストで時間のみを入れ替えています。
ws1.Cells(a, 6)にお名前
ws1.Cells(a, 4)にカット・カラー・トリートメントのどの予約なのかが入ります。

大変申し訳ございませんが、おかしな箇所がありましたらご指摘下さいますと幸いです。よろしくお願い申し上げます。

・ツリー全体表示


	【81852】Re:VBAでのグラフのデータラベル表示につ...

sky - 21/6/29(火) 9:28 -


	引用なし

	パスワード

エクセルの学校（[[20210622160511]]）にて返答をいただけたので此方はクローズさせていただきます。
場所を貸していただきありがとうございました。

・ツリー全体表示


	【81851】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/6/28(月) 17:31 -


	引用なし

	パスワード

>条件に当てはまらない人が出てくるのはどこかで条件が間違っているか
>もしくは列の指定が間違っているかだと思います。
>コードをコピペしてくれたら原因を指摘できるかもしれません。
>12時の範囲がA2:B6で決まっているのだったらFor Eachでセルの値が空白ならその場所に書き込むとかでもいいかもしれません
>
>Sub sample
>　　Dim rng12 As Range: Set rng12 = Worksheets("シート2.").Range("A2:B6")
>　　Dim rng As Range
>　　For Each rng In rng12 'rng12内でループ
>　　　　If rng.Value = "" Then
>　　　　　　rng.Value = "空白発見"
>　　　　　　Exit For
>　　　　End If
>　　Next
>End Sub
丸２が文字化けして2.に置き換わってます注意

・ツリー全体表示


	【81850】Re:次の列に続けて同じ処理を繰り返す方法

山内 - 21/6/28(月) 17:30 -


	引用なし

	パスワード

▼VBA初心者コウさん：
>ご丁寧に教えていただきありがとうございます。
>教えていただいたものを調べまして、
>IFを使用して判別をしました。
>しかし、判別で漏れるはずの時間帯の人が2列目に出てくるなど、
>色々試してみましたが、隣の列に続けるところで処理がうまくいきません。
>隣の列に続ける場合はどのように入力したらよろしいのでしょうか。
>また。12時の最終行を取得という場合にはどのようにしたら良いのでしょうか。
>私の説明が乏しいのですが、知識がないもので上手く説明できず…。
>お手間をお取りして申し訳ございません。
>よろしければご教授くださいませ。

条件に当てはまらない人が出てくるのはどこかで条件が間違っているか
もしくは列の指定が間違っているかだと思います。
コードをコピペしてくれたら原因を指摘できるかもしれません。
12時の範囲がA2:B6で決まっているのだったらFor Eachでセルの値が空白ならその場所に書き込むとかでもいいかもしれません

Sub sample
　　Dim rng12 As Range: Set rng12 = Worksheets("シート2.").Range("A2:B6")
　　Dim rng As Range
　　For Each rng In rng12 'rng12内でループ
　　　　If rng.Value = "" Then
　　　　　　rng.Value = "空白発見"
　　　　　　Exit For
　　　　End If
　　Next
End Sub

・ツリー全体表示


	【81849】VBAでのグラフのデータラベル表示について

sky - 21/6/28(月) 9:55 -


	引用なし

	パスワード

※エクセルの学校（[[20210622160511]]）とのマルチポスト投稿になります。ご了承ください

現在、下記の表（本来の表だと行数が多いのでイメージ）からVBAで複数のグラフを作ろうとしています。

　
　　　　[A]　　　　|[B]　　　　|[C]　　　　|[D]　　　　|[E]　　　　|[F]
[ 1]（大内訳1）　　　　|　　　　|　　　　|　　　　|　　　　|10000
[ 2]　　　　　　　　|Aさん　　　　|3000　　　　|0.3　　　　|〇100%　　　　|
[ 3]　　　　　　　　|Bさん　　　　|2000　　　　|0.2　　　　|　　　　|
[ 4]　　　　　　　　|Cさん　　　　|1000　　　　|0.1　　　　|　　　　|
[ 5]　　　　　　　　|　　　　|0　　　　|　　　　|　　　　|
――――――――――――――――――――――――――――――――
[ 6]　　　　　　　　|Dさん　　　　|3000　　　　|0.3　　　　|　　　　|
[ 7]　　　　　　　　|Eさん　　　　|1000　　　　|0.1　　　　|　　　　|
[ 8]　　　　　　　　|　　　　|0　　　　|　　　　|　　　　|
――――――――――――――――――――――――――――――――
[ 9]（大内訳2）　　　　|　　　　|　　　　|　　　　|　　　　|
[10]　　　　　　　　|Fさん　　　　|
　・
　・
　・

　
A・B・FとC・D・Eはそれぞれ別シートからコピーしたもので、C行には計算式（C3なら=F2*D3）、EにはD列の大内訳1つごとにF行と比較して数値が100%一致するかをif関数（=IF(SUM(D3:D8)=1,"〇 "&SUM(D3:D8)*100&"%","× "&SUM(D3:D8)*100&"%")）で見ています。
またA・B・Fをコピーしたシートは本来2～8行目の部分は存在せず、コピーしてから空白行を行数決め打ちで増やしています。
　
ここから現在、大内訳の全体（1～8行目）を円グラフ、大内訳を更に区分けしたもの（小内訳A（1～5列目）と小内訳B（6～8行目））を100%積み上げ横棒で作成しています。
大内訳は毎回変わりますが大体10個程度と決め打ちしました。
　
ここからが問題になりますが、小内訳の中の人数も毎回変動があり、どうしても空白行ができてしまいます。
そして空白行ができてしまうと分類名のデータラベルがうまく出てくれません。
空白行を削除しようとしても、グラフの範囲自体も決め打ちで作成してしまったためグラフ範囲がずれてしまいます。
このVBAを作った後、グラフ作成に慣れていない人に渡す必要があるので手動での修正が行えません。

現在の運用方法は
　1　別のマクロでA・B・FとC・D・Eにそれぞれ別のシートから列を貼り付けて3行目～19行目（イメージで言う2行目～8行目）の空白行を増やす。以降の大内訳も同様に17行ごと増やす
　2　3行目～19行目のB列に名前、D列に数値の比率を手入力
　3　今回提示したマクロを使ってグラフを3種類作る
と言った動きを考えています。
この時にBに空欄セルがある状態でグラフを出力するとB列の名前が出ず、データソースでも項目軸ラベルがなしになっています。
Bが全部埋まった状態だと項目軸ラベルでBが選択されるので、空欄があってもこの状態を目指したいです。
どなたかお力添えをお願いいたします。
　
　
以下、作成したvbaになります。
上のイメージ表と範囲行が違いますがご了承ください。

-----------------------

Sub グラフ作成()
　　　　Worksheets("グラフ用").Activate
　　　　'既にあるグラフを削除
　　　　Dim i As Long
　　　　With ActiveSheet
　　　　　　　　 For i = .ChartObjects.Count To 1 Step -1
　　　　　　　　.ChartObjects(i).Delete
　　　　　　　　Next i
　　　　End With
　
'グラフ作成1---------------------------------------
　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'ドーナツグラフ追加_凡例はグラフの上
　　　　　　　　.ChartType = xlDoughnut
　　　　　　　　.SetSourceData Range("b3:c19")
　　　　　　　　.SetElement (msoElementDataLabelCallout)
　　　　　　　　.HasLegend = False
　　　　End With
　　　　
　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'100% 積み上げ横棒グラフ追加
　　　　　　　　.ChartType = xlBarStacked100
　　　　　　　　.SetSourceData Range("b3:c12")
　　　　　　　　.ChartColor = 14
　　　　
　　　　　　　　Select Case .PlotBy
　　　　　　　　Case xlRows
　　　　　　　　　　　　.PlotBy = xlColumns
　　　　　　　　Case xlColumns
　　　　　　　　　　　　.PlotBy = xlRows
　　　　　　　　End Select
　　　　End With

　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'100% 積み上げ横棒グラフ追加
　　　　　　　　.ChartType = xlBarStacked100
　　　　　　　　.SetSourceData Range("b13:c19")
　　　　　　　　.ChartColor = 17
　　　　　　　　
　　　　　　　　Select Case .PlotBy
　　　　　　　　Case xlRows
　　　　　　　　　　　　.PlotBy = xlColumns
　　　　　　　　Case xlColumns
　　　　　　　　　　　　.PlotBy = xlRows
　　　　　　　　End Select
　　　　End With
　
'グラフ作成2---------------------------------------
　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'ドーナツグラフ追加
　　　　　　　　.ChartType = xlDoughnut
　　　　　　　　.SetSourceData Range("b21:c37")
　　　　　　　　.SetElement (msoElementDataLabelCallout)
　　　　　　　　.HasLegend = False
　　　　End With
　　　　
　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'100% 積み上げ横棒グラフ追加
　　　　　　　　.ChartType = xlBarStacked100
　　　　　　　　.SetSourceData Range("b21:c30")
　　　　　　　　.ChartColor = 14
　　　　　　　　
　　　　　　　　Select Case .PlotBy
　　　　　　　　Case xlRows
　　　　　　　　　　　　.PlotBy = xlColumns
　　　　　　　　Case xlColumns
　　　　　　　　　　　　.PlotBy = xlRows
　　　　　　　　End Select
　　　　End With
　　　　
　　　　With ActiveSheet.Shapes.AddChart.Chart
　　　　'100% 積み上げ横棒グラフ追加
　　　　　　　　.ChartType = xlBarStacked100
　　　　　　　　.SetSourceData Range("b31:c37")
　　　　　　　　.ChartColor = 17
　　　　　　　　
　　　　　　　　Select Case .PlotBy
　　　　　　　　Case xlRows
　　　　　　　　　　　　.PlotBy = xlColumns
　　　　　　　　Case xlColumns
　　　　　　　　　　　　.PlotBy = xlRows
　　　　　　　　End Select
　　　　End With

（以下繰り返しなので割愛）

End Sub

・ツリー全体表示


	【81848】Re:次の列に続けて同じ処理を繰り返す方法

VBA初心者コウ - 21/6/27(日) 21:09 -


	引用なし

	パスワード

ご丁寧に教えていただきありがとうございます。
教えていただいたものを調べまして、
IFを使用して判別をしました。
しかし、判別で漏れるはずの時間帯の人が2列目に出てくるなど、
色々試してみましたが、隣の列に続けるところで処理がうまくいきません。
隣の列に続ける場合はどのように入力したらよろしいのでしょうか。
また。12時の最終行を取得という場合にはどのようにしたら良いのでしょうか。
私の説明が乏しいのですが、知識がないもので上手く説明できず…。
お手間をお取りして申し訳ございません。
よろしければご教授くださいませ。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

31 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free