Excel VBA質問箱 IV

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

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


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

179 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【78874】Re:２シートの一致照合と計算、一致項目...

β - 17/2/17(金) 19:34 -


	引用なし

	パスワード

▼まるばつさん：

↑　要件がクリアではなく削除になっても対応しやすいようにしましたが
クリアでかわらないということなら

　　For i = mx To 2 Step -1 '最終行から２行目までを繰り返し処理

これを

　　For i = 2 To mx '２行目から最終行までを繰り返し処理

のほうが素直でいいです。

・ツリー全体表示


	【78873】Re:２シートの一致照合と計算、一致項目...

β - 17/2/17(金) 19:31 -


	引用なし

	パスワード

▼まるばつさん：

Sheet2 の最終行　456 GHI の C列が 456DEF になっているのは　456GHI の間違いだとして。

効率化を求めれば、もっと複雑なコード記述になりますが、ＶＢＡが、あまり得意ではない
ということなので、１行ずつ　２つのシートをシート関数のMATCH で比較して処理しています。

『削除』ということですが、質問内の結果サンプルでは『クリア』ですので
以下のコードでも行削除ではなく、行のクリアにしています。

掲示板上、コードが改行されてみにくいのですが、モジュールにコピペすれば
見やすくなると思います。

Sub Sample()
　　Dim sh1 As Worksheet
　　Dim sh2 As Worksheet
　　Dim sh3 As Worksheet
　　Dim i As Long
　　Dim mx As Long
　　Dim k As String
　　Dim z As Variant

　　
　　Application.ScreenUpdating = False
　　
　　Set sh1 = Sheets("Sheet1")
　　Set sh2 = Sheets("Sheet2")
　　Set sh3 = Sheets("Sheet3")
　　
　　mx = sh1.Range("A" & Rows.Count).End(xlUp).Row　'Sheet1 の最終セルの行番号
　　
　　For i = mx To 2 Step -1 '最終行から２行目までを繰り返し処理
　　　　k = sh1.Cells(i, "C").Value　　 'その行のC列の値
　　　　z = Application.Match(k, sh2.Range("A1").CurrentRegion.Columns("C"), 0)　　 'その値がSHeet2のC列にあるかどうか
　　　　If IsNumeric(z) Then　　'あった
　　　　　　sh1.Cells(i, "D").Value = sh1.Cells(i, "D").Value - sh2.Cells(z, "D").Value　　 'D列のセル Sheet1-Sheet2
　　　　　　sh1.Cells(i, "E").Value = sh1.Cells(i, "E").Value - sh2.Cells(z, "E").Value　　 'E列のセル Sheet1-Sheet2
　　　　　　sh1.Rows(i).Copy sh3.Range("A" & Rows.Count).End(xlUp).Offset(1)　　　　　　　　'この時点のSheet3の最終行の次の行に追加
　　　　　　sh1.Rows(i).ClearContents　'Sheet1の該当行をクリア
　　　　　　sh2.Rows(z).ClearContents　'SHeet2の該当行をクリア
　　　　End If
　　Next
　　
End Sub

・ツリー全体表示


	【78872】２シートの一致照合と計算、一致項目の削...

まるばつ - 17/2/17(金) 18:36 -


	引用なし

	パスワード

初めて質問させていただきます。私は関数は少々わかるもののVBAがさっぱりなので
インターネットで検索していたところここを見つけました。

シート1に

　　　A　　　　　　　B　　　　　　C　　　　E　　F　　G～Z
1　伝票番号　型番　A＆B　　個数　金額　項目色々
2　123　　　ABC　　123ABC　　2　 2000
3　123　　　DEF　　123DEF　　4　 8000
4　456　　　ABC　　456ABC　　1　 1000
5　456　　　GHI　　456GHI　　2　 6000
6　456　　　DEF　　456DEF　　3　 6000

シート2に

　　　A　　　　　　　B　　　　　　C　　　　E　　F　　G～Z
1　伝票番号　型番　A＆B　　個数　金額　項目色々
2　123　　　DEF　　123DEF　　4　 8000
3　456　　　GHI　　456GHI　　1　 3000
4　456　　　GHI　　456DEF　　3　 6000

というエクセルの表があります。

シート1の列C（A&B）をシート2の列C（A&B）と照会し、一致するものがあれば
引き算（シート1　―　シート2）をして、新しシートに書き込みをしてシート1と2から削除するマクロを
教えて頂きたいと思っております。
マクロを実行するたびにシート3に追記できる形でお願いします。

結果として

シート1に

　　　A　　　　　　　B　　　　　　C　　　　E　　F　　G～Z
1　伝票番号　型番　A＆B　　個数　金額　項目色々
2　123　　　ABC　　123ABC　　2　 2000
3　
4　456　　　ABC　　456ABC　　1　 1000
5　
6　456　　　DEF　　456DEF　　3　 6000

シート2に

　　　A　　　　　　　B　　　　　　C　　　　E　　F　　G～Z
1　伝票番号　型番　A＆B　　個数　金額　項目色々
2　
3　
4　456　　　GHI　　456DEF　　3　 6000

シート3に

　　　A　　　　　　　B　　　　　　C　　　　E　　F　　G～Z
1　伝票番号　型番　A＆B　　個数　金額　項目色々
2　123　　　DEF　　123DEF　　0　 0
3　456　　　GHI　　456GHI　　1　 3000
4　

となるようなことをマクロでできるのでしょうか？
できるならどんなプログラムになるのか教えて頂きたいと思います。
どうかよろしくお願いします。

・ツリー全体表示


	【78870】Re:フラグが立つ全通りの表示

γ - 17/2/14(火) 23:51 -


	引用なし

	パスワード

実行したいことを端的に説明したほうがよいでしょう。
配列などを上手く使って、繰り返し計算をするということですね。

籤だとか余計な話を入れないほうがよい。
まあ、コードを作るということは、機械に向かって説明するということですよ。
人間に向かって説明が難しいなら、
機械にはさらに理解してもらえないでしょう。

・ツリー全体表示


	【78869】Re:フラグが立つ全通りの表示

あらけい - 17/2/14(火) 23:42 -


	引用なし

	パスワード

回答ありがとうございます

>別に上のような表を書くこと自体が
>最終的な目標ではないんでしょうかねえ。
>もう少し実行したいことを明確に書いて欲しい。

最終的な目的はこのフラグを使って計算をおこない
もっとも高い値が出る並びを知りたいことです。

言葉足らずで申し訳ございません。

まさに、おこないたかったことができました。
ありがとうございます。

これを基に、３回だけでなく複数回おこなったときの
プログラムを考えたいと思います。

非常に助かりました！

・ツリー全体表示


	【78868】Re:フラグが立つ全通りの表示

γ - 17/2/14(火) 22:48 -


	引用なし

	パスワード

引数の型宣言を忘れていました。
Function do_task(i As Long, j As Long, k As Long, p As Long)

・ツリー全体表示


	【78867】Re:フラグが立つ全通りの表示

γ - 17/2/14(火) 20:52 -


	引用なし

	パスワード

> このフラグを使って計算をしたいと考えており
ということは、
>　1回目 1 0 0
>　2回目 0 1 0
>　3回目 0 1 0
別に上のような表を書くこと自体が
最終的な目標ではないんでしょうかねえ。
もう少し実行したいことを明確に書いて欲しい。

返事も無いから、また放置組なんでしょうか。
まあいいや。

とりあえず、その表を書くコードを示して置こう。
A1:A3に○回目という文字列を入れた状態で、
以下を実行してください。

Sub test()
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim p As Long
　　p = 1
　　For i = 1 To 3
　　　　For j = 1 To 3
　　　　　　For k = 1 To 3
　　　　　　　　Call do_task(i, j, k, p)
　　　　　　Next
　　　　Next
　　Next
End Sub
Function do_task(i, j, k, p)
　　p = p + 4
　　Cells(1, 1).Resize(3, 1).Copy Cells(p, 1)
　　Cells(p, 2).Resize(3, 3).Value = 0
　　Cells(p, 1 + i).Value = 1
　　Cells(p + 1, 1 + j).Value = 1
　　Cells(p + 2, 1 + k).Value = 1
End Function

・ツリー全体表示


	【78866】Re:フラグが立つ全通りの表示

γ - 17/2/14(火) 7:37 -


	引用なし

	パスワード

>3回に1回必ず当たるくじ
というのもどういうものかと思いますし、
>1回目　1　0　0
のそれぞれの1,0,0の意味もわかりません.
一つだけ当たりの入った籤を、3人が同時に引くと言うことですか？
それを3回繰り返す時の、全パターンを列挙する、と。

For i = 1 to 3
　 For j = 1 to 3
　　　For k = 1 to 3
　　　　　i,j,kを使って作業をする
　　　Next
　 Next
Next
というのが基本形でしょう。
ご自分でトライしてみて、つまったところでまた質問してください。

・ツリー全体表示


	【78865】フラグが立つ全通りの表示

あらけい - 17/2/14(火) 0:14 -


	引用なし

	パスワード

よろしくお願いします。

3回に1回必ず当たるくじを複数回おこないます。
このとき、はずれはセルに「0」を、当たりは「1」としてフラグを立てます。

1回目　1　0　0
2回目　0　1　0
3回目　0　1　0

3回おこなうケースだと27通りが考えられると思います。
（ｘ回では、3^x通りだと思いますが…）

このフラグを使って計算をしたいと考えており
要は、全パターンを順番に表示させていきたいのです。

よい方法があれば、ご教示願います。

・ツリー全体表示


	【78864】Re:特定の指名した氏名にバックカラーを...

トキノハジメ - 17/2/12(日) 18:51 -


	引用なし

	パスワード

▼β さん：
早速のご指導有難う御座います。

vbRed　等の記述は初めてですので勉強になります。

色々試してみます。

これからも宜しくお願い致します。

有難うございました。

・ツリー全体表示


	【78863】Re:特定の指名した氏名にバックカラーを...

β - 17/2/12(日) 17:28 -


	引用なし

	パスワード

▼トキノハジメさん：

回答の前に。

・条件付書式はもちろんご存知ですよね？
・マクロ記録も、もちろんご存知ですよね？

>コードに埋め込んで問題なく動いております。

まず、この設定を反映させるセル領域が、シート上で決まっていれば
あるいは、行数は増減しても、列についいては開始行も含めてきまっていれば
手作業で、条件付き書式を１度、このシートに設定しておけば、マクロでは
何もしなくてもＯＫなんですよ？

また、仮に手作業ではなく、その１度限りの処理でもマクロで行いたい
ということであれば、私がアップしたコードの、設定対象領域を必要なものにして
１回実行すればいいわけで、毎回、マクロ実行するたびに設定をやりなおす必要は
全くありません。
（まぁ、その都度やり直しても実害はないですが）

で、背景色とともに、文字色も変えたいということなら、その条件付き書式設定の
操作を行う。それをマクロ記録してみる。

できあがったコードと私がアップしたコードを見比べれば、どこに何を追加したら
いいかが、たちどころにわかると思いますが？

まぁ、それらは、今後のトキノハジメさんの開発に生かしてもらうとして
面倒なので（？）以下。

Sub Sample()
　　With Range("A1", Cells(1, Columns.Count).End(xlToLeft))
　　　　.FormatConditions.Delete
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　　　"=OR(A1=""山田"",A1=""沼田"")"
　　　　With .FormatConditions(.FormatConditions.Count)
　　　　　　With .Interior
　　　　　　　　.PatternColorIndex = xlAutomatic
　　　　　　　　.Color = vbRed
　　　　　　　　.TintAndShade = 0
　　　　　　End With
　　　　　　With .Font
　　　　　　　　.Color = vbWhite
　　　　　　End With
　　　　End With
　　　　.FormatConditions.Add Type:=xlExpression, Formula1:= _
　　　　　　"=OR(A1=""川田"",A1=""西村"")"
　　　　With .FormatConditions(.FormatConditions.Count)
　　　　　　With .Interior
　　　　　　　　.PatternColorIndex = xlAutomatic
　　　　　　　　.Color = vbCyan
　　　　　　　　.TintAndShade = 0
　　　　　　End With
　　　　　　With .Font
　　　　　　　　.Color = vbWhite
　　　　　　End With
　　　　End With
　　End With
End Sub

・ツリー全体表示


	【78862】Re:特定の指名した氏名にバックカラーを...

トキノハジメ - 17/2/12(日) 16:12 -


	引用なし

	パスワード

▼β さん：

有難うございます。コードまで頂いてすみません。
コードに埋め込んで問題なく動いております。
一つ甘えついでに教えて下さい。バックカラーをつた文字を色をしろにしたいのですが、宜しくお願い致します・

・ツリー全体表示


	【78861】Re:特定の指名した氏名にバックカラーを...

トキノハジメ - 17/2/12(日) 16:07 -


	引用なし

	パスワード

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

・ツリー全体表示


	【78860】Re:ファイル移動

ピアニッチ - 17/2/12(日) 11:37 -


	引用なし

	パスワード

コード内容を検証しながら、動作確認を致しました。
ファイル選択ではダイアログを使用した方がパス取得に効果的なのですね。

'元ファイルフォルダの親フォルダ
　　path1 = Range("C12").Value
課題として親フォルダが複数あるケース（Range("C13").Value）で同様にファイルを移動後、ファイル名を変更するという処理があるのですが、まずは自力で行いたいと思います。

ご回答して頂いた方々、お世話になりました。

・ツリー全体表示


	【78859】Re:worksheetのコピー貼り付け

γ - 17/2/12(日) 9:59 -


	引用なし

	パスワード

修正すべき最大のものは、
>・検索対象のシートが特定されていない。
のところです。

標準モジュールに書かれたプロシージャで、
シート名が省略されると、現在アクティブなシートが前提とされます。
ループ内の後半で、"請求書鑑"がアクティブにされていますから、
次の検索処理では、そのシートのなかを検索してしまうことになります。

こういったことを頭に置いて、
コードに手を入れてください。

もう完成しているなら良いけれど、そうでないならQ/Aを続けたらどうかと。

・ツリー全体表示


	【78858】Re:ファイル移動

β - 17/2/11(土) 23:43 -


	引用なし

	パスワード

▼ピアニッチさん：

新しいファイル名をどうしたいのかが見えませんので以下では
N1.jpg のままにしてあります。（★　のところ）
ここは、実際のものに変えてください。

移動シート.xls というのは、このマクロブックのことだという前提。

現在の構成は　ある親フォルダ配下のサブフォルダを INPUTBOX入力で
指定させ、そのサブフォルダ内の N1.jpg を対象にしていますね。
そうではなく、直接、ファイル選択ダイアログで、N1.jpg を選ばせたほうが
よろしいかとは思いますが、そちらの構成通り、まずフォルダを選ばせます。
ただし、INPUTBOX ではなくフォルダ選択ダイアログを表示して選択させます。

Sub Sample()
　　Dim myFso As Object
　　Dim path1 As String
　　Dim oPath As String
　　Dim nPath As String
　　Dim oName As String
　　Dim nName As String
　　Dim oFile As String
　　Dim nFile As String
　　
　　oName = "N1.jpg"
　　nName = "N1.jpg"　　　　'★
　　
　　Set myFso = CreateObject("Scripting.FileSystemObject")
　　'元ファイルフォルダの親フォルダ
　　path1 = Range("C12").Value
　　If Right(path1, 1) <> "\" Then path1 = path1 & "\"
　　'フォルダ選択
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.InitialFileName = path1
　　　　.Title = "フォルダを選んでください"
　　　　.Show
　　　　If .SelectedItems.Count = 0 Then Exit Sub　 'キャンセルボタン
　　　　oPath = .SelectedItems(1)
　　End With
　　
　　nPath = ThisWorkbook.Path
　　oFile = oPath & "\" & oName
　　nFile = nPath & "\" & nName
　　
　　'転記元　N1.pdf の存在チェック
　　If Not myFso.fileexists(oFile) Then
　　　　MsgBox "ファイルが存在しません"
　　　　Exit Sub
　　End If
　　'転記先ファイルの削除（念のため）
　　If myFso.fileexists(nFile) Then myFso.GetFile(nFile).Delete Force:=True
　　'ファイル移動
　　myFso.MoveFile oFile, nFile
　　
　　MsgBox "ファイルを移動しました"
　　
End Sub

・ツリー全体表示


	【78857】Re:ファイル移動

ピアニッチ - 17/2/11(土) 23:16 -


	引用なし

	パスワード

ご教授の程、よろしくお願いします。

Sub 転送()
　　Dim myFso As Object
　　Dim path1 As String
　　Dim path2 As String
　　Dim path3 As String
　　Dim day As String
　　Dim oFilN1 As String
　　Dim nFilN1 As String
　　Debug.Print
　　Set myFso = CreateObject("Scripting.FileSystemObject")
　　'移動元ファイルの検索と移動先の指定
　　path1 = Range("C12")
　　day = InputBox("日付を入力して下さい")
　　If day <> Empty Then
　　　　day = CInt(day)
　　Else
　　　　Exit Sub
　　End If
　　oFilN1 = Dir(path1 & "\" & day & "\" & "N1.jpg")
　　nFilN1 = Workbooks("起動シート.xls").path
　　MsgBox oFilN1

　　
　　If Not myFso.fileExists(filespec:=oFilN1) Then
　　　 myFso.MoveFile oFilN1, nFilN1
　　End If
　　Set myFso = Nothing
End Sub
　　

・ツリー全体表示


	【78856】Re:ファイル移動

β - 17/2/11(土) 23:00 -


	引用なし

	パスワード

▼ピアニッチさん：

>質問の際、記述を誤って投稿してしまいました。

掲示板にコードを手打ちされたんですか？
混乱の元です。

実際のコードをコピペでアップしてください。

・ツリー全体表示


	【78855】Re:ファイル移動

ピアニッチ - 17/2/11(土) 22:38 -


	引用なし

	パスワード

>oFilN1 = Dir(path1 & "\" & day & "\" & "N1.jpg", vbNormal)

>myFso.MoveFile oFilN1, nFilN1

おっしゃる通り、oFilN1 は　N1.jpg（ファイル名）と返ってきます。
なぜフォルダパス文字列が返ってこないのか理解できていません。
フォルダパス文字列が返ってこない為、移動ができていない状況です。

>If Not myFso.fileExists(filespec:=oFilN1) Then
判定に関して・・特に強い意味はありません。

> Replace(path1 & buffer1, "N1.jpg", "N1#1_001.jpg")
質問の際、記述を誤って投稿してしまいました。
申し訳ありません。

なにぶん、素人の為意味不明な点が多々あると思いますが、
ご理解いただきたい。

・ツリー全体表示


	【78854】Re:ファイル移動

β - 17/2/11(土) 21:51 -


	引用なし

	パスワード

▼ピアニッチさん：

ちょっと　危なっかしいコードですね。

oFilN1 = Dir(path1 & "\" & day & "\" & "N1.jpg", vbNormal)

もし、N1.jpg　が指定フォルダにない場合、oFilN1 は　空白値（""）になります。
存在していたとしても　oFilN1 は　N1.jpg だけ（ファイル名だけ）になります。

If Not myFso.fileExists(filespec:=oFilN1) Then

ここでファル名しか与えていない（パス文字列がない）のもきわめて気になります。

仮に N1.jpg が指定フォルダにあっても、FSOから見れば、どのフォルダ？
（カレントディレクトリーだと判断？）結果は　存在しないと判定 --> MoveFileは実行される。

N1.jpg がなければ、もちろん　ないと判定され　MoveFileが実行される。

myFso.MoveFile oFilN1, nFilN1

この時、oFilN1 の値はどうなっているでしょうか？
ちゃんとしたフォルダパス文字列も含んだファイルフルパス文字列になっているでしょうか？

そもそもが、If Not myFso.fileExists(filespec:=oFilN1) Then
ここでは何を判定したかったのですか？

で、

Replace(path1 & buffer1, "N1.jpg", "N1#1_001.jpg")

これは何をしているつもりでしょう。
単に、メモリー内の文字列を変換しているだけですけど？

・ツリー全体表示


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

179 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free