Excel VBA質問箱 IV

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

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


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

17 / 3840 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【82141】Re:Pasteメソッド失敗

あおこ - 23/4/5(水) 11:40 -


	引用なし

	パスワード

▼MK さん：
>↓のコードとご自身のコードをよく見比べてみてください。
>どこか違ってるとことがあります。
>
>ht　tps://daitaideit.com/vba-shapes-copy-paste/

ありがとうございました！！できました。

ご提示いただいたページも参考にしていたのですが、気付かなかったです。
「マクロの記録」で記録されたコードでは「copy」だったので・・。

ほんとうにありがとうございました。

・ツリー全体表示


	【82140】Re:Pasteメソッド失敗

MK - 23/4/4(火) 19:12 -


	引用なし

	パスワード

↓のコードとご自身のコードをよく見比べてみてください。
どこか違ってるとことがあります。

ht　tps://daitaideit.com/vba-shapes-copy-paste/

・ツリー全体表示


	【82139】Pasteメソッド失敗

あおこ - 23/4/4(火) 15:59 -


	引用なし

	パスワード

いつも参考にさせていただいています。

マクロ実行ブック内のシートの図形"Picture 1"を、別ブックのシート全てにコピペしようと下記のコードを組んでいますが、「ActiveSheet.Paste '←とまる」のところで「実行時エラー1004　Pasteメソッドが失敗しました」のエラーが出ます。

再実行するときちんと図形が貼り付けられており、また、1行ずつ実行するとエラーにならないので、コードはあっているのではないかと思うのですが・・。

解消方法がありましたら、ご教示いただけるとありがたいです。

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

Sub 表加工()

～宣言～
　
　Set wb1 = ThisWorkbook
　Set sh2 = wb1.Worksheets("手配表用")’コピー元シート
　　　
　Call ChangeCurPath　''カレントディレクトリをネットワーク上のパスにチェンジ　　
　　
'対象ブックを選択します
OpenFileName = Application.GetOpenFilename("Microsoft Excel ブック
,*.xls*")
　　If OpenFileName = "False" Then Exit Sub
　　　　　　
　　On Error GoTo 0
　　　　
　　'読み込み
　　 Set wb2 = Workbooks.Open(OpenFileName) 'wb2 読込元　　
　　 Application.ScreenUpdating = False　'画面表示を止める

　　 Dim WS As Worksheet
　　 For i = 1 To wb2.Worksheets.Count '全てのシートを読み込みます。
　　
　　　Set WS = wb2.Worksheets(i)
　　　　
　　　'図形コピー
　　　sh2.Activate 'マクロ実行ファイルのコピー元シート
　　　ActiveSheet.Shapes("Picture 1").Select
　　　Selection.Copy
　　　wb2.Activate 'コピー先ファイル
　　　WS.Activate
　　　WS.Range("U1").Select
　　　ActiveSheet.Paste '←とまる
　　
　　　Next i
　　
　　 wb2.Worksheets(1).Select
　　
　　 Application.ScreenUpdating = True
　　 Application.StatusBar = False
　　 MsgBox "処理が終了しました。"
　　
　　
　 End Sub

・ツリー全体表示


	【82138】Re:日付の検索

初心者 - 23/3/29(水) 16:56 -


	引用なし

	パスワード

「LookIn:=xlFormulas」する事でうまくいきました。
検討して下さった方々、ありがとうございました。

・ツリー全体表示


	【82137】日付の検索

初心者 - 23/3/29(水) 16:13 -


	引用なし

	パスワード

Sub CommandButton3_Click()

　Dim CalcDay as Date, MyRange as Range

　CalcDay = Date
　Set MyRange = Range("A:A").Find(What:=CalcDay, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns)
　MyRange.select

End Sub

Ａ列に日付が並んでいるワークブックにて、上記マクロにてDateがある日付のセルをSelectしたいのですが、
MyRangeはNothingのままで、Selectしてくれません。書式を変えてみましたがダメでした。

何が原因なのでしょうか？ご教示願います。

・ツリー全体表示


	【82136】Sub 条件式書式の再設定()

叱問箱 - 23/3/14(火) 6:51 -


	引用なし

	パスワード

条件式書式が設定されたセルに行を挿入したりフィルハンドルすると適用先が変わってしまいますので、マクロの自動記録で再設定できるようにしました。これに例えば10行目に一行挿入したり10行目にオートフィルをした場合に、チェンジイベントでマクロ名「Sub 条件式書式の再設定()」が自動動作するようにお願いします
チェンジイベントマクロはB列だけの5行目以降からのみに適用してください。
自動記録で取っていますのでコードが長いです
動作が同じでしたら簡略化されるとなおベストです

Sub 条件式書式の再設定()
　　Range("A5").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=LEN($A5:$A2000)=1"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　　Range("B5").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=LEN($B5:$B2000)=1"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　　Application.CutCopyMode = False
　　Cells.FormatConditions.Delete
　　Range("A5").Select
　　Range("B5").Activate
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=LEN($A5:$A2000)=1"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　　Range("B5:B2000").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=ISERROR(FIND(""("",$B5:$B2000,1))"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 5296274
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　　Range("B5:B2000").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=$B5:$B2000="""""
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 49407
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　　Range("B5:B2000").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=LEN($B5:$B2000)=1"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
　 Range("A5:A2000").Select
　　Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　"=LEN($A5:$A2000)=1"
　　Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
　　With Selection.FormatConditions(1).Interior
　　　　.PatternColorIndex = xlAutomatic
　　　　.Color = 65535
　　　　.TintAndShade = 0
　　End With
　　Selection.FormatConditions(1).StopIfTrue = False
End Sub

Sub 一行挿入()
　　Range("B10").Select
　　Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub

Sub 一行オートフィル()
　　Selection.AutoFill Destination:=Range("A10:B10"), Type:=xlFillDefault
　　Range("A10:B10").Select
End Sub

・ツリー全体表示


	【82135】Re:カスタムリストでの並び替えについて

ken - 23/3/11(土) 10:30 -


	引用なし

	パスワード

▼マナさん：
>▼ken さん：
>
>こうでは？
>
>　　With Sheets("Sheet3").Sort
>　　　　.SortFields.Clear
>　　　　.SortFields.Add2 Key:=Range("A1"), CustomOrder:=Join(lst, ",")

有難う御座いました。
ちゃんと並び替え出来ました。
配列は今勉強をはじめたばかりなので参考になりました。
もっと勉強します。

・ツリー全体表示


	【82134】Re:カスタムリストでの並び替えについて

マナ - 23/3/10(金) 23:17 -


	引用なし

	パスワード

▼ken さん：

こうでは？

　　With Sheets("Sheet3").Sort
　　　　.SortFields.Clear
　　　　.SortFields.Add2 Key:=Range("A1"), CustomOrder:=Join(lst, ",")

・ツリー全体表示


	【82133】Re:カスタムリストでの並び替えについて

ken

- 23/3/10(金) 19:13 -


	引用なし

	パスワード

▼マナさん：
>▼ken さん：
>
>2007以降なら、これを使用するのが簡単ではありませんか。
>ht　tp://officetanaka.net/excel/vba/tips/tips189.htm

お世話になります。
リストをカスタムオーダーに入れてみましたが
エラーになってしまいます。

マクロは下記です。
Sub Sample_2()
　　Dim lst As Variant
　　With Sheets("Sheet2")
　　　　lst = WorksheetFunction.Transpose _
　　　　(Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)))
　　End With
　　With Sheets("Sheet3")
　　　　.SortFields.Clear
　　　　.SortFields.Add2 Key:=Range("A1"), CustomOrder:=lst
　　　　.SetRange Range("A1").CurrentRegion
　　　　.Header = xlYes
　　　　.Apply
　　End With
　　End Sub

・ツリー全体表示


	【82132】Re:do whileでループしないです。。。

マナ - 23/3/1(水) 20:46 -


	引用なし

	パスワード

▼れさん：

ht　tps://www.limecode.jp/entry/trap/dirindir

・ツリー全体表示


	【82131】do whileでループしないです。。。

れ

- 23/3/1(水) 20:08 -


	引用なし

	パスワード

下記コードでループせず1回で終了してしまいます。
何回見直してもわかりません、ご教授お願いできませんでしょうか。
よろしくお願いします。
対象のフォルダには3つ以上の.xlsxファイルがあります。

Sub 販売営業インセンティブへの転記()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim fp As String
　　fp = ThisWorkbook.path
Dim 行先 As String
　　行先 = "C:\Users\5058\Desktop\販売営業インセンティブ"
Dim 対象 As String
　　対象 = Dir(fp & "\" & "インセンティブ" & "\" & "*.xlsx")
Do Until 対象 = ""
　　Dim 店番 As String
　　　店番 = Left(対象, 3) & "*"
　　Dim 行先フォルダ As String
　　　行先フォルダ = Dir(行先 & "\" & 店番, vbDirectory)
　　Dim FSO As Object
　　 Set FSO = CreateObject("Scripting.FileSystemObject")
　　FSO.CopyFile fp & "\" & "インセンティブ" & "\" & 対象, 行先 & "\" & 行先フォルダ & "\"
　　対象 = Dir()
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【82130】Re:カスタムリストでの並び替えについて

ken

- 23/2/28(火) 7:13 -


	引用なし

	パスワード

▼マナさん：
>▼ken さん：
>
>2007以降なら、これを使用するのが簡単ではありませんか。
>ht　tp://officetanaka.net/excel/vba/tips/tips189.htm

ご教授有難う御座います。
試してみます。

・ツリー全体表示


	【82129】Re:カスタムリストでの並び替えについて

マナ - 23/2/27(月) 14:58 -


	引用なし

	パスワード

▼ken さん：

2007以降なら、これを使用するのが簡単ではありませんか。
ht　tp://officetanaka.net/excel/vba/tips/tips189.htm

・ツリー全体表示


	【82128】カスタムリストでの並び替えについて

ken - 23/2/26(日) 9:32 -


	引用なし

	パスワード

何度か質問してお世話になってます。
今回もどうしても解決しないので投稿しました。

データベースは1000行くらいで20列あります。
並び替えのリストは30項目位あり変動します。
シート３のデータをシート２のリストで並び変えた後で
保存しようとするとエクセル自体が終了してしまいます。
他のPCでやっても同様です。
最後の　 Application.DeleteCustomList ListNum:= _
　　Application.CustomListCount
をコメントブロックすると問題なく保存できますがリストが
残っている状態です。
マクロは下記です。
どなたか宜しくお願い致します。

Sub Sample()
　　Dim lst As Variant
　　With Sheets("Sheet2")
　　　　lst = WorksheetFunction.Transpose _
　　　　(Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)))
　　End With
　　Application.AddCustomList ListArray:=lst
　　With Sheets("Sheet3")
　　　　.Range("A1").CurrentRegion.Sort Key1:= _
　　　　　　.Columns("A"), Order1:=xlAscending, _
　　　　　　OrderCustom:=Application.CustomListCount + 1, Header:=xlYes
　　End With
　　Application.DeleteCustomList ListNum:= _
　　Application.CustomListCount
End Sub

・ツリー全体表示


	【82127】Re:欠席理由を個人毎に集計したい

POO - 23/2/22(水) 9:02 -


	引用なし

	パスワード

▼マナさん：

ありがとうございます。
やってみます。
>
>ピボットテーブルをおすすめします。

・ツリー全体表示


	【82126】Re:欠席理由を個人毎に集計したい

マナ - 23/2/20(月) 10:50 -


	引用なし

	パスワード

▼POO さん：

ピボットテーブルをおすすめします。

・ツリー全体表示


	【82125】Re:欠席理由を個人毎に集計したい

POO - 23/2/20(月) 10:20 -


	引用なし

	パスワード

▼マナさん：すみません。わかりずらくなりました。下記がデータと結果です（データ）氏名　　　　年　　　　性別　　　　日付　　　　区分　　　　理由 A　　　　1　　　　女　　　　44664　　　　出席停止　　　　学級閉鎖 A　　　　1　　　　女　　　　44665　　　　出席停止　　　　学級閉鎖 A　　　　1　　　　女　　　　44666　　　　出席停止　　　　学級閉鎖 A　　　　1　　　　女　　　　44715　　　　出席停止　　　　感染症の疑い A　　　　1　　　　女　　　　44907　　　　出席停止　　　　感染症の疑い A　　　　1　　　　女　　　　44914　　　　出席停止　　　　感染症の疑い B　　　　1　　　　女　　　　44664　　　　出席停止　　　　学級閉鎖 B　　　　1　　　　女　　　　44665　　　　出席停止　　　　学級閉鎖 B　　　　1　　　　女　　　　44666　　　　出席停止　　　　学級閉鎖 B　　　　1　　　　女　　　　44677　　　　出席停止　　　　感染症の疑い C　　　　1　　　　男　　　　44664　　　　出席停止　　　　学級閉鎖 C　　　　1　　　　男　　　　44665　　　　出席停止　　　　学級閉鎖 C　　　　1　　　　男　　　　44666　　　　出席停止　　　　学級閉鎖 C　　　　1　　　　男　　　　44668　　　　出席停止　　　　新型コロナウイルス感染症 C　　　　1　　　　男　　　　44670　　　　出席停止　　　　新型コロナウイルス感染症 C　　　　1　　　　男　　　　44720　　　　早退　　　　　　　　腹痛 D　　　　1　　　　男　　　　44839　　　　病気欠席　　　　腹痛 D　　　　1　　　　男　　　　44847　　　　出席停止　　　　感染症の疑い D　　　　1　　　　男　　　　44859　　　　出席停止　　　　感染症の疑い D　　　　1　　　　男　　　　44865　　　　病気欠席　　　　嘔吐・嘔気（結果）　　　　年　　　　性別　　　　日付　　　　出席停止　　　　早退　　　　病気欠席　　　　学級閉鎖　　　　感染症の疑い　　　　新型コロナウイルス感染症　　　　腹痛 A　　　　1　　　　女　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 B　　　　1　　　　女　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 C　　　　1　　　　男　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 D　　　　1　　　　男　　　　　　　　　　　　　　　　　　　　　　　　氏名と年をキーに各合計を計算する形です。　　　　　　　　　　　　区分を出席停止、早退、病気欠席とし、その理由を学級閉鎖　感染症疑い　新型コロナ・・で氏名一人毎に合計を出すというものです。すみません。宜しくお願いします。

・ツリー全体表示


	【82124】Re:欠席理由を個人毎に集計したい

マナ - 23/2/18(土) 15:17 -


	引用なし

	パスワード

▼POO さん：

>１レコードに氏名、グループ、欠席要件、欠席理由

>Ａさん　風邪１、インフル０、コロナ０

どのようなデータなのか、例をみてもわかりません。
グループは？欠席要件は？
欠席理由は１列？それとも４列
対応する見出しがわかるようにしてください。

・ツリー全体表示


	【82123】欠席理由を個人毎に集計したい

POO - 23/2/17(金) 14:14 -


	引用なし

	パスワード

教えてください。
Excelの機能で、「統合」という機能に変わる、ＶＢＡ記述についてお知恵を拝借したく。
１レコードに氏名、グループ、欠席要件、欠席理由（風邪、インフルエンザ、コロナ、その他）とした、データが記録されています。（3500レコード）
これらを、氏名＋グループ毎に、欠席要件以降の数値を合算したいのですが、うまい方法が見つかりません。
例えば
Ａさん　風邪１、インフル０、コロナ０
Ａさん　風邪１、インフル１、コロナ１

Ｂさん　風邪０、インフル２、コロナ１
を
結果
Ａさん｜Ａグループ｜風邪２。インフル１、コロナ１
Ｂさん｜Ａグループ｜風邪０、インフル２、コロナ１

の様な表に氏名とグループが重複しないようにして、各理由の合計を集計したいでのです。

統合の代替となるＶＢＡはどのようにするのが良いか。どなたかご伝授ください。
サンプルなどでもあれば助かります。
宜しくお願いします。

・ツリー全体表示


	【82122】Re:行の削除

マルチネス - 23/1/26(木) 7:16 -


	引用なし

	パスワード

情報共有

ht　tps://www.excel.studio-kazu.jp/kw/20230124091546.html

・ツリー全体表示


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

17 / 3840 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free