Excel VBA質問箱 IV

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

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


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

104 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80388】Re:時間の足し算を行うと、yyyy/mm/dd h...

amatsubo

- 19/2/8(金) 8:35 -


	引用なし

	パスワード

▼マナさん：
>▼amatsuno さん：
>　　　　　　　　　　
>>
>>また、出力先の列を変更する場合、
>>（ここでは、1・2列目に出しているものを、1・3列目にしたい）
>>はどこを変えればよいのでしょうか？
>
>
>With .Range("A1").Resize(dic2.Count)
>　　.EntireColumn.ClearContents
>　　.Value = Application.Transpose(dic2.Keys)
>End With
>With .Range("C1").Resize(dic2.Count)
>　　.EntireColumn.ClearContents
>　　.Value = Application.Transpose(dic2.items)
>　　.NumberFormatLocal = "h:mm:ss"
>End With

ありがとうございます。
対応できました

・ツリー全体表示


	【80387】Re:時間の足し算を行うと、yyyy/mm/dd h...

amatsubo

- 19/2/8(金) 8:35 -


	引用なし

	パスワード

▼マナさん：
>▼amatsuno さん：
>　　　　　　　
>>TEST,　　　　15,　　　　USR3,　　　　8:41:14　　　　　　　　　　　　
>>TEST,　　　　15,　　　　USR3,　　　　5:41:03　　　　　　　　　　　　
>>TEST,　　　　15,　　　　USR3,　　　　0:28:32　　　　　　　　　　　　
>>TEST,　　　　15,　　　　USR3,　　　　2:26:55　　　　　　　　　　　　
>　　　　　　　　　　　
>>　
>> 上記を実行したとき、出力先のカラム2の値がyyyy/mm/dd h/mm/ss表記(カラム2が15の列　⇒ 1900/1/4　15:18:37)
>> となり、また、合計値が正常でない値（01:17:44と出る予定）が出力されてしまいます
>
>
>17:17:44となりますが？

すいません。上記記載いただいたため、こちらでも何度か確認したのですが、
どうしても1900/1/4　15:18:37でます。
貼り付け時にフォーマット指定を入れる必要があるのでしょうか？

・ツリー全体表示


	【80386】Re:ワークシートをコピーし空白行を削除...

マナ - 19/2/7(木) 19:13 -


	引用なし

	パスワード

▼nonchan さん：

>テンプレートには合計600行あって、そのテンプレートには
>vlookup関数が仕込んであり、他のデータベースから引っ張って
>きたデータを検索するようになっています。

理解しました。

>失敗しました！！

コードを見た感じでは、問題ないように思えますが。
失敗とは、削除されないということでしょうか。

ステップ実行とか試してみましたか。

・ツリー全体表示


	【80385】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/7(木) 11:40 -


	引用なし

	パスワード

▼γ さん：
>カレンダには日付データが、日を表示するだけの形式でセットされているとの前提です。
>straightforwardに、こんなコードではどうでしょうか。
>
>Sub カレンダー入力2()
>　　Dim ws　　　　　As Worksheet
>　　Dim lastRow　　 As Long　　
>　　Dim rngCalendar As Range　　
>　　Dim rngFound　　As Range　
>　　Dim d　　　　　 As Long
>　　Dim s　　　　　 As String
>　　Dim k　　　　　 As Long
>
>　　Set ws = Worksheets("Sheet1")
>　　lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
>　　Set rngCalendar = ws.Range("E1:K10")
>
>　　For k = 1 To lastRow
>　　　　d = ws.Cells(k, "A").Value　'日付け
>　　　　s = ws.Cells(k, "B").Value　'スケジュール
>　　　　Set rngFound = rngCalendar.find(Day(d), After:=rngCalendar(1), _
>　　　　　　LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
>　　　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False)
>　　　　
>　　　　'日でマッチさせると、たかだか2回マッチするだけなのでDo Loopは不要?
>　　　　If d = rngFound.Value Then
>　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)
>　　　　Else
>　　　　　　Set rngFound = rngCalendar.FindNext(rngFound)
>　　　　　　If Not rngFound Is Nothing Then
>　　　　　　　　If d = rngFound.Value Then
>　　　　　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)
>　　　　　　　　End If
>　　　　　　End If
>　　　　End If
>　　Next
>End Sub
>Function setSchedule(r As Range, s As String)
>　　If r.Value = "" Then
>　　　　r.Value = s
>　　Else
>　　　　r.Value = r.Value & vbLf & s
>　　End If
>End Function

γ様

いつもお世話になっております。
γ様のvbaを参考に自分で作成してみたのですが

If d = rngFound.Value Then
　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)
　　　　Else
　　　　　　Set rngFound = rngCalendar.FindNext(rngFound)
　　　　　　If Not rngFound Is Nothing Then
　　　　　　　　If d = rngFound.Value Then
　　　　　　　　　　Call setSchedule(rngFound.Offset(1, 0), s)

↑の部分がうまくいきません。
原因として考えられるのは、検索した結果(rngFound)がdと一つも当てはまらなかった場合の処理が入っていないということかなと思うのですが、その場合どうすればいいでしょうか？

自分としてはIf Not rngFound Is Nothing Thenを使えばいいと思い、何度か組んでみたのですがすべてエラーになってしまうので、教えていただきたいです。

・ツリー全体表示


	【80384】Re:ワークシートをコピーし空白行を削除...

nonchan

- 19/2/6(水) 21:23 -


	引用なし

	パスワード

マナさん。ありがとうございます。

テンプレートには合計600行あって、そのテンプレートには
vlookup関数が仕込んであり、他のデータベースから引っ張って
きたデータを検索するようになっています。
ちょっと説明しづらいのですが、

「WBS001]　「WBS002」「WBS003」　～　[WBS030」
というふうに30コのワークシートができて、それぞれ
データが最大600行、少ないものでは30行程度のワークシート
ができあがります。
600行びっしりデータがあるワークシートと空白行がいっぱい
あるワークシートとが出来上がってしまうのです。

空白行を削除するマクロでワークシートひとつづつ消してい
けばいいのですが、それでは手間がかかってしまうので、
複数のワークシートの空白行を一度に削除できるマクロを
作成したいと思ったのです。

わかりにくい説明で大変申し訳ありません。
よろしくお願いいたします。

▼マナさん：
>そもそも空白行の削除は
>テンプレートで最初に1回だけ
>でよいのでは？

・ツリー全体表示


	【80383】Re:ワークシートをコピーし空白行を削除...

マナ - 19/2/6(水) 18:28 -


	引用なし

	パスワード

そもそも空白行の削除は
テンプレートで最初に1回だけ
でよいのでは？

・ツリー全体表示


	【80382】ワークシートをコピーし空白行を削除した...

nonchan

- 19/2/6(水) 17:25 -


	引用なし

	パスワード

初めて質問します。VBA初心者です。

【やりたい事】
ワークシート「ﾃﾝﾌﾟﾚｰﾄ」をコピーし、「WBSﾘｽﾄ」にある名前をワークシート名に
して、空白行を削除した後、「WBSﾘｽﾄ」にある全部の名前のワークシートを作成
する。

【やってみた事】
1.ワークシート「ﾃﾝﾌﾟﾚｰﾄ」をコピーし、「WBSﾘｽﾄ」にある名前をワークシート名に
　して、「WBSﾘｽﾄ」にある全部の名前のワークシートを作成する。
　　　　　↓
Sub 経費予算資料作成()
　　Application.ScreenUpdating = False
　　
　　Dim i As Long
　　For i = 2 To Sheets("WBSﾘｽﾄ").Cells(Rows.Count, "A").End(xlUp).Row
　　　　Sheets("ﾃﾝﾌﾟﾚｰﾄ").Copy after:=Sheets(Sheets.Count)
　　　　ActiveSheet.Name = Sheets("WBSﾘｽﾄ").Cells(i, "A")
　　　　Range("A1") = Sheets("WBSﾘｽﾄ").Cells(i, "A")
　　Next i

End Sub
　　　　　↓
これは上手くいきました。

2.アクティブなワークシートの空白行を削除する。
　　　　　↓
Sub test空白行を削除する()
　　Application.ScreenUpdating = False
　　
　　Dim j As Long
　　For j = 630 To 2 Step -1
　　　　If Range("R" & j).Value = "空白行" Then
　　　　　　Rows(j).Select
　　　　　　Selection.Delete shift:=xlUp
　　　　End If
　　Next j
End Sub
　　　　　↓
これも上手くいきました。

3.　1.+2.ワークシートを作成したら、空白行を削除して
　次のワークシートを作成する。
　　　　　↓
Sub test経費予算資料作成空白行削除()
　　Application.ScreenUpdating = False
　　
　　Dim i As Long
　　For i = 2 To Sheets("WBSﾘｽﾄ").Cells(Rows.Count, "A").End(xlUp).Row
　　　　Sheets("ﾃﾝﾌﾟﾚｰﾄ").Copy after:=Sheets(Sheets.Count)
　　　　ActiveSheet.Name = Sheets("WBSﾘｽﾄ").Cells(i, "A")
　　　　Range("A1") = Sheets("WBSﾘｽﾄ").Cells(i, "A")
　　　　
　　　　　　Dim j As Long
　　　　　　For j = 630 To 2 Step -1
　　　　　　　　　If Range("R" & j).Value = "空白行" Then
　　　　　　　　　　 Rows(j).Select
　　　　　　　　　　Selection.Delete shift:=xlUp
　　　　　　End If
　　　　Next j
　　　
　　Next i
End Sub
　　　　↓
失敗しました！！

1.と2.を合体させることができません。
3.のプロシージャの訂正、或いは何かいい方法はないでしょうか。

よろしくお願いいたします。
以上　

・ツリー全体表示


	【80381】Re:時間の足し算を行うと、yyyy/mm/dd h...

マナ - 19/2/5(火) 20:32 -


	引用なし

	パスワード

▼amatsuno さん：
　　　　　　　　　　
>
>また、出力先の列を変更する場合、
>（ここでは、1・2列目に出しているものを、1・3列目にしたい）
>はどこを変えればよいのでしょうか？

With .Range("A1").Resize(dic2.Count)
　　.EntireColumn.ClearContents
　　.Value = Application.Transpose(dic2.Keys)
End With
With .Range("C1").Resize(dic2.Count)
　　.EntireColumn.ClearContents
　　.Value = Application.Transpose(dic2.items)
　　.NumberFormatLocal = "h:mm:ss"
End With

・ツリー全体表示


	【80380】Re:カレンダーに予定を自動入力したい

マナ - 19/2/5(火) 19:47 -


	引用なし

	パスワード

▼VBA初心者さん：

>↑の部分で検索していると思っていましたが、違いますでしょうか・・・？

そうなのですが、検索できなかったはずでは？
今は検索できていても、いつかまた検索できないとなる場合もあるはずです。
そのときは、γさんの回答を参考にしてください。
実際に経験すると理解できるかと思いますので
わたしからは修正案は提示しません。

-----
で、複数シートの検索の件ですが、
日付から、何月のシートを検索すればよいかわかるはずです。
すべてシートを検索する必要はないという意味です。

　

・ツリー全体表示


	【80379】Re:時間の足し算を行うと、yyyy/mm/dd h...

マナ - 19/2/5(火) 18:30 -


	引用なし

	パスワード

▼amatsuno さん：
　　　　　　　
>TEST,　　　　15,　　　　USR3,　　　　8:41:14　　　　　　　　　　　　
>TEST,　　　　15,　　　　USR3,　　　　5:41:03　　　　　　　　　　　　
>TEST,　　　　15,　　　　USR3,　　　　0:28:32　　　　　　　　　　　　
>TEST,　　　　15,　　　　USR3,　　　　2:26:55　　　　　　　　　　　　
　　　　　　　　　　　
>　
> 上記を実行したとき、出力先のカラム2の値がyyyy/mm/dd h/mm/ss表記(カラム2が15の列　⇒ 1900/1/4　15:18:37)
> となり、また、合計値が正常でない値（01:17:44と出る予定）が出力されてしまいます

17:17:44となりますが？

・ツリー全体表示


	【80378】時間の足し算を行うと、yyyy/mm/dd h/mm...

amatsuno

- 19/2/5(火) 15:17 -


	引用なし

	パスワード

excel上で時間表記されているカラムの足し算を行うと、
足し算の結果セルがyyyy/mm/dd h/mm/ss表記になってしまいました。

また、足し算の合計値が想定と違う結果になってしまいます

元excelのシート
TEST,　　　　1,　　　　TEST,　　　　3577:00:59　　　　　　　　
TEST,　　　　3,　　　　USR2,　　　　3330:25:19　　　　　　　　
TEST,　　　　3,　　　　USR2,　　　　3381:50:06　　　　　　　　
TEST,　　　　15,　　　　USR3,　　　　8:41:14　　　　　　　　　　　　
TEST,　　　　15,　　　　USR3,　　　　5:41:03　　　　　　　　　　　　
TEST,　　　　15,　　　　USR3,　　　　0:28:32　　　　　　　　　　　　
TEST,　　　　15,　　　　USR3,　　　　2:26:55　　　　　　　　　　　　
TEST,　　　　18,　　　　USR3,　　　　10:14:12　　　　　　　　
TEST,　　　　18,　　　　USR3,　　　　5:17:49　　　　　　　　　　　　
TEST,　　　　18,　　　　USR3,　　　　0:22:22　　　　　　　　　　　　
TEST,　　　　18,　　　　USR3,　　　　3:30:58　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　0:46:43　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　0:39:59　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　3:33:07　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　3:36:23　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　0:59:02　　　　　　　　　　　　
TEST,　　　　19,　　　　USR4,　　　　0:31:00　　　　　　　　　　　　

上記の状態で、カラム2が同一の番号の時間（カラム4）を合計しようとしています。

With Worksheets("元")
　　　For i3 = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
　　　　 vK2 = .Cells(i3, "B").Value
　　　　 dic2(vK2) = dic2(vK2) + .Cells(i3, "D")
　　　Next
　 End With

　 ReDim vA3(1 To dic2.Count, 1 To 2)
　 i3 = 0
　 For Each vK2 In dic2.Keys
　　　i3 = i3 + 1
　　　vA3(i3, 1) = vK2
　　　vA3(i3, 2) = dic2(vK2)
　 Next

　 Application.ScreenUpdating = False
　 With Worksheets("出力先")
　　　With .Range("A1").Resize(i3, 2)
　　　　 .EntireColumn.ClearContents
　　　　 .Value = vA3
　　　　 .Columns(2).NumberFormatLocal = "h:mm:ss"
　　　　 .Columns(4).NumberFormatLocal = "h:mm:ss"
　　　　 Application.Goto .Cells(1), True
　　　End With
　 End With
　 Application.ScreenUpdating = True

　 Rows(1).Insert
　
上記を実行したとき、出力先のカラム2の値がyyyy/mm/dd h/mm/ss表記(カラム2が15の列　⇒ 1900/1/4　15:18:37)
となり、また、合計値が正常でない値（01:17:44と出る予定）が出力されてしまいます

上記コードのどこが誤っているのでしょうか？
お分かりになられる方、よろしくお願いいたします

また、出力先の列を変更する場合、
（ここでは、1・2列目に出しているものを、1・3列目にしたい）
はどこを変えればよいのでしょうか？

・ツリー全体表示


	【80377】:ForーNext

トキノハジメ - 19/2/5(火) 9:29 -


	引用なし

	パスワード

▼マナさん：よろずや　さん

ありがとう御座いました。

大変プログラムが短くなりました。

これからもよろしくお願いいたします。

・ツリー全体表示


	【80376】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/5(火) 9:23 -


	引用なし

	パスワード

▼マナさん：
>▼VBA初心者さん：
>
>>追加でご質問させていただいてもよろしいでしょうか？
>
>そのまえに、わたしの提示したマクロでは検索できていませんよね。
>それでもよいのですか？

マナ様

お返事ありがとうございます。
Set rng検索 = rngカレンダー.Find(c.Value, LookAt:=xlWhole)
　　　　
　　　　If Not rng検索 Is Nothing Then
　　　　　　With rng検索.Offset(1, 0)
　　　　　　　　業務 = WorksheetFunction.Trim(c.Offset(0, 1).Value & " " & .Value)

↑の部分で検索していると思っていましたが、違いますでしょうか・・・？

・ツリー全体表示


	【80375】Re:カレンダーに予定を自動入力したい

VBA初心者 - 19/2/5(火) 9:10 -


	引用なし

	パスワード

▼γ さん：
>ああ、そうでしたか、
>質問者さんの「できない」を信用してしまったのですが、
>LookIn:=xlValuesをLookIn:=xlFormulas　にすれば
>日ではなくそんままの値を検索値にして、
>ユニークに特定でき、二度調べる必要はなかったのですね。
>不覚・・・。
>

γ様
お返事ありがとうございます。
教えていただいたことを参考に、自分でもう一度調べながらやってみようと思います！
本当にありがとうございました！

・ツリー全体表示


	【80374】Re:ForーNext

よろずや - 19/2/4(月) 22:23 -


	引用なし

	パスワード

横レスです

　　　　.AutoFilter Field:=1. Criteria1:="8"
　　　　　　　　　　　　　 ↓
　　　　.AutoFilter Field:=1, Criteria1:="8"

・ツリー全体表示


	【80373】Re:ForーNext

トキノハジメ - 19/2/4(月) 22:09 -


	引用なし

	パスワード

▼マナさん：
>▼トキノハジメさん：
>
>こうでしょうか
>
>Sub test()
>　　Dim k As Long
>
>　　For k = 0 To 4
>　　　　Cells(12 + k * 20, "AU").Resize(18).Copy
>　　　　Cells(12 + k, "C").PasteSpecial Paste:=xlValues, Transpose:=True
>　　Next
>
>
>　　With Range("BL11").CurrentRegion
>　　　　.AutoFilter Field:=1. Criteria1:="8"
>　　
>　　　　For k = 0 To 5
>　　　　　　.AutoFilter Field:=2, Criteria1:=k + 1
>　　　　　　.Copy Range("BE" & 11 + k * 20)
>　　　　Next
>　　　　.AutoFilter
>　　End With
>　　
>End Sub

早速の回答有り難う御座います。

Criteria1　のところで文字が赤くなってしまうのですが、
打ち込み間違いはないと思うのですが
宜しくおねがいいたします。

・ツリー全体表示


	【80372】Re:ForーNext

マナ - 19/2/4(月) 19:14 -


	引用なし

	パスワード

▼トキノハジメさん：

こうでしょうか

Sub test()
　　Dim k As Long

　　For k = 0 To 4
　　　　Cells(12 + k * 20, "AU").Resize(18).Copy
　　　　Cells(12 + k, "C").PasteSpecial Paste:=xlValues, Transpose:=True
　　Next

　　With Range("BL11").CurrentRegion
　　　　.AutoFilter Field:=1. Criteria1:="8"
　　
　　　　For k = 0 To 5
　　　　　　.AutoFilter Field:=2, Criteria1:=k + 1
　　　　　　.Copy Range("BE" & 11 + k * 20)
　　　　Next
　　　　.AutoFilter
　　End With
　　
End Sub

・ツリー全体表示


	【80371】ForーNext

トキノハジメ - 19/2/4(月) 18:39 -


	引用なし

	パスワード

いつもお世話になります。

下記のコードをFor－Nextにするにわうどすればよいのでしょうか。

Range("AU12:AU29").Copy
Range("C12:T12").PasteSpecial , Passte:=xlValues, Transpose:=True
Range("AU32:AU49").Copy
Range("C13:T13").PasteSpecial , Passte:=xlValues, Transpose:=True
Range("AU52:AU69").Copy
Range("C14:T14").PasteSpecial , Passte:=xlValues, Transpose:=True
Range("AU72:AU89").Copy
Range("C15:T15").PasteSpecial , Passte:=xlValues, Transpose:=True
Range("AU92:AU109").Copy
Range("C16:T16").PasteSpecial , Passte:=xlValues, Transpose:=True

With Range("BL11")
　　.AutoFilter Field:=1. Criteria1:="8"
　　.AutoFilter Field:=2. Criteria1:="1"
　　.CurrentRegion.Copy Range("BE11")
　　.AutoFilter
End Witu
With Range("BL11")
　　.AutoFilter Field:=1. Criteria1:="8"
　　.AutoFilter Field:=2. Criteria1:="2"
　　.CurrentRegion.Copy Range("BE31")
　　.AutoFilter
End Witu

With Range("BL11")
　　.AutoFilter Field:=1. Criteria1:="8"
　　.AutoFilter Field:=2. Criteria1:="3"
　　.CurrentRegion.Copy Range("BE51")
　　.AutoFilter
End Witu

With Range("BL11")
　　.AutoFilter Field:=1. Criteria1:="8"
　　.AutoFilter Field:=2. Criteria1:="4"
　　.CurrentRegion.Copy Range("BE71")
　　.AutoFilter
End Witu

With Range("BL11")
　　.AutoFilter Field:=1. Criteria1:="8"
　　.AutoFilter Field:=2. Criteria1:="5"
　　.CurrentRegion.Copy Range("BE91")
　　.AutoFilter
End Witu

以上２組ですが、教えて下さい。
宜しくお願い致します。

・ツリー全体表示


	【80370】Re:EXCELのユーザーフォームにあるリスト...

くるみ - 19/2/3(日) 3:31 -


	引用なし

	パスワード

データベースに別項目で状態を準備し、それによってリストボックスの内容を変えました。
ご指導いただきありがとうございました。

・ツリー全体表示


	【80369】Re:カレンダーに予定を自動入力したい

γ - 19/2/2(土) 13:30 -


	引用なし

	パスワード

ああ、そうでしたか、
質問者さんの「できない」を信用してしまったのですが、
LookIn:=xlValuesをLookIn:=xlFormulas　にすれば
日ではなくそんままの値を検索値にして、
ユニークに特定でき、二度調べる必要はなかったのですね。
不覚・・・。

・ツリー全体表示


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

104 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free