Excel VBA質問箱 IV

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

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


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

350 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【75420】Re:値の貼り付け方法

マナ - 14/3/22(土) 17:20 -


	引用なし

	パスワード

おそらく、こうでしょうか。

Option Explicit

Sub 抽出月()
　　Dim 終行 As Long

　　Application.ScreenUpdating = False

　　Range("B7:R35").ClearContents

　　Range("T6:Z400").AdvancedFilter _
　　　　Action:=xlFilterInPlace, _
　　　　CriteriaRange:=Range("GG1:GI2"), _
　　　　Unique:=True
　　Range("T6:Z400").Copy
　　Range("B6").PasteSpecial Paste:=xlPasteValues
　　ActiveSheet.ShowAllData
　　
　　終行 = Range("b36").End(xlUp).Row
　　
　　Range("B6:H" & 終行).Sort _
　　　　Key1:=Range("B6"), _
　　　　Order1:=xlAscending, _
　　　　Header:=xlYes
　　
　　Range("i7:i" & 終行).Formula = "=Sum(E7:H7)"
　　
　　Range("n7:r" & 終行).FormulaR1C1 = "=ROUNDDOWN(RC[-9]/RC4,1)"
'　 ↑がわかりにくければ、かわりに↓
'　　Range("n7:n" & 終行).Formula = "=ROUNDdown(E7/D7,1)"
'　　Range("o7:o" & 終行).Formula = "=ROUNDdown(F7/D7,1)"
'　　Range("p7:p" & 終行).Formula = "=ROUNDdown(G7/D7,1)"
'　　Range("q7:q" & 終行).Formula = "=ROUNDdown(H7/D7,1)"
'　　Range("r7:r" & 終行).Formula = "=ROUNDdown(I7/D7,1)"
　　　
　　Range("b7", "d" & 終行).Copy
　　Range("k7").PasteSpecial xlPasteValues
　　Application.CutCopyMode = False
　　
　　Range("r4").Select
　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【75419】Re:値の貼り付け方法

りんご - 14/3/22(土) 15:36 -


	引用なし

	パスワード

ありがとうございました。自分だけではなかなか解決できなくて困っていました。自己流で作った文は次のように活用させて頂きました。

　Sub 抽出月()
　　　
　　　 Range("B7:R35").Select
　　　 Selection.ClearContents
　　　 Range("r4").Select
　
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.DisplayAlerts = False

　　　　Range("T6:Z400").AdvancedFilter _
　　　　Action:=xlFilterInPlace, _
　　　　CriteriaRange:=Range("GG1:GI2"), _
　　　　 Unique:=True
　　　　Range("T6:Z400").Copy
　　　　Range("B6").PasteSpecial Paste:=xlPasteValues
　　　　ActiveSheet.ShowAllData

　　　　　Range("B6:I35").Sort Key1:=Range("B6"), Order1:=xlAscending, Header:=xlYes

　　　　　終行 = Range("ｂ35").End(xlUp).Row
　　　
　　　For k = 7 To 終行
　　　
　　　　　Range("i7:i" & k & "").Formula = "=Sum(E７:H７)"
　　　　　Range("n7:n" & k & "").Value = Array("=ROUNDdown(E7/D7,1)")
　　　　　Range("o7:o" & k & "").Value = Array("=ROUNDdown(F7/D7,1)")
　　　　　Range("p7:p" & k & "").Value = Array("=ROUNDdown(G7/D7,1)")
　　　　　Range("q7:q" & k & "").Value = Array("=ROUNDdown(H7/D7,1)")
　　　　　Range("r7:r" & k & "").Value = Array("=ROUNDdown(I7/D7,1)")
　　
　　　　　　　
　　　　 Range("b" & 終行 + 1 & ":i35") = ClearContents
　　　　 Range("K" & 終行 + 1 & ":R35") = ClearContents
　　　　　
　　　　　
　　　　　Range("b7", "d" & k & "").Copy
　　　　　Range("k7").PasteSpecial xlPasteValues
　　　　　Application.CutCopyMode = False
　　　　　Range("r4").Select
　　　
　　　 Next k
　　
　　
　　Application.DisplayAlerts = True
　　Application.Calculation = xlCalculationAutomatic
　　Application.Calculate
　　Application.ScreenUpdating = True

End Sub
　

・ツリー全体表示


	【75418】Re:値の貼り付け方法

マナ - 14/3/22(土) 11:05 -


	引用なし

	パスワード

今は、しっかりと基本的な構文をまず理解することが必要な気がします。

ht tp://www.happy2-island.com/excelsmile/smile03/capter00505.shtml
ht tp://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_advancedfilter.html

Range("B6;H400").ClearContents
Range("T6:Z400").AdvancedFilter _
　　Action:=xlFilterInPlace, _
　　CriteriaRange:=Range("GG1:GI2"), _
　　Unique:=True
Range("T6:Z400").Copy
Range("B6").PasteSpecial Paste:=xlPasteValues
ActiveSheet.ShowAllData

・ツリー全体表示


	【75417】Re:値の貼り付け方法

りんご - 14/3/22(土) 9:25 -


	引用なし

	パスワード

▼マナさん：
>AdvancedFilterメソッドで値のみを抽出するには？
>ht tp://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200907/09070111.txt

ありがとうございます。早速

Range("T6:Z400").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"gG1:gI2"), CopyToRange:=Range("B6:H35"), Unique:=False

このように書き換えしました
range("T6:Z400") .advancedfilter action:=xlfilterinplace, unique:=true
range("T6:Z400") .copy.range( _
"gG1:gI2").pastespecial paste:=xlpastevalues
activesheet.showalldata

　　構文エラーとなり、前に進めません。マクロ始めて３ケ月目です。なかなか理解が難しいので、再度ご指導願います。

・ツリー全体表示


	【75416】Re:［無題］

りんご - 14/3/22(土) 8:54 -


	引用なし

	パスワード

早速の回答ありがとうございました。一部訂正　＜＞を＝　にしてＯＫでした。

・ツリー全体表示


	【75415】Re:離れた行の行No取得

亜矢 - 14/3/22(土) 8:45 -


	引用なし

	パスワード

▼kanabun さん：
>▼kanabun さん：
>>▼亜矢さん：
>>
>>>　　選択が終了するとシート作ってあるコマンドボタンで色色処理を行います。
>>>　　行Noは他の所でその行のデータ（１５列ほど）を使用するために使います。
>>
>>>>　　ReDim LiN(1 To Target.Areas.Count) 'Area数
>>
>>>>　　For Each Gyo In Target.Areas
>>>>　　　　i = i + 1
>>>>　　　　LiN(i) = Gyo.Row
>>>>　　Next
>>
>>↑で、Target は選択された行。
>> 配列 LiN() のなかに、行番号が入ります。
>
>Targetという変数はワークシートのイベント・プロシージャで自動で付けられた
>名前なので、標準モジュールで処理するときは、これを Selection に代えれば
>いいです。
>
>　　Dim Gyo as Range
>　　ReDim LNo(1 To Selection.Areas.Count) As Long
>
>　　For Each Gyo In Selection.Areas
>　　　　i = i + 1
>　　　　LNo(i) = Gyo.Row
>　　Next
>
>Lno()配列に選択された行の行番号が入っています。
ありがとうございました。解決しました。

・ツリー全体表示


	【75414】Re:値の貼り付け方法

マナ - 14/3/21(金) 19:04 -


	引用なし

	パスワード

AdvancedFilterメソッドで値のみを抽出するには？
ht tp://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200907/09070111.txt

・ツリー全体表示


	【75413】Re:離れた行の行No取得

kanabun - 14/3/21(金) 18:52 -


	引用なし

	パスワード

▼kanabun さん： >▼亜矢さん： > >>　　選択が終了するとシート作ってあるコマンドボタンで色色処理を行います。 >>　　行Noは他の所でその行のデータ（１５列ほど）を使用するために使います。 > >>>　　ReDim LiN(1 To Target.Areas.Count) 'Area数 > >>>　　For Each Gyo In Target.Areas >>>　　　　i = i + 1 >>>　　　　LiN(i) = Gyo.Row >>>　　Next > >↑で、Target は選択された行。 > 配列 LiN() のなかに、行番号が入ります。 Targetという変数はワークシートのイベント・プロシージャで自動で付けられた名前なので、標準モジュールで処理するときは、これを Selection に代えればいいです。　　Dim Gyo as Range 　　ReDim LNo(1 To Selection.Areas.Count) As Long 　　For Each Gyo In Selection.Areas 　　　　i = i + 1 　　　　LNo(i) = Gyo.Row 　　Next Lno()配列に選択された行の行番号が入っています。

・ツリー全体表示


	【75412】Re:離れた行の行No取得

kanabun - 14/3/21(金) 17:51 -


	引用なし

	パスワード

▼亜矢さん： >　　選択が終了するとシート作ってあるコマンドボタンで色色処理を行います。 >　　行Noは他の所でその行のデータ（１５列ほど）を使用するために使います。 >>　　ReDim LiN(1 To Target.Areas.Count) 'Area数 >>　　For Each Gyo In Target.Areas >>　　　　i = i + 1 >>　　　　LiN(i) = Gyo.Row >>　　Next ↑で、Target は選択された行。配列 LiN() のなかに、行番号が入ります。

・ツリー全体表示


	【75411】値の貼り付け方法

りんご

- 14/3/21(金) 16:21 -


	引用なし

	パスワード

　次のような張付マクロがあります。これを値で張付するにはどう書けばいい　　　でしょうか？初心者のためなかなか不明が多いです。詳しい方の御教示をお願い　　します。

　' Range("T6:Z400").AdvancedFilter Action:=xlFilterCopy, 　　　　　　　　　　CriteriaRange:=Range( _
　　　　' "gG1:gI2"), CopyToRange:=Range("B6:H35"), Unique:=False
　　　　

・ツリー全体表示


	【75410】Re:［無題］

マナ - 14/3/21(金) 13:38 -


	引用なし

	パスワード

できるだけ元のコードを残してありますが
順番はあちこち入れ替えました。
データがないので動作確認はしていません。

Option Explicit

Sub まとめて登録()
　　Dim 登録 As Worksheet, 当月 As Worksheet
　　Dim 月 As Long, 日 As Long
　　Dim 縦 As Long, 最終行 As Long
　　Dim msg As Long
　　Dim 行 As Long
　　
　　Set 登録 = Worksheets("登録")
　　月 = 登録.Cells(4, 18).Value
　　日 = 登録.Cells(4, 20).Value

　　msg = MsgBox("入力内容を登録月" & 月 & "シートに転送します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbExclamation, "入力内容の転送")
　　If msg <> vbOK Then MsgBox "操作を中断しました": Exit Sub
　　
　　Set 当月 = Worksheets("登録月" & 月)
　　縦 = 7
　　Do Until 当月.Cells(縦, 20).Value = ""
　　　　縦 = 縦 + 1
　　Loop

　　If WorksheetFunction.CountIf(当月.Range(当月.Cells(7, 20), 当月.Cells(縦, 20)), 日) >= 1 Then
　　　　msg = MsgBox("この日付データはすでに登録されています ", vbOKOnly + vbExclamation)
　　　　If msg <> vbOK Then Exit Sub
　　End If
　　　
　　Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.DisplayAlerts = False
　　　　
　　　
'最終行を取得（Q23から上方向に牽索）
　　最終行 = 登録.Cells(23, 17).End(xlUp).Row
　　　
　　For 行 = 7 To 最終行
　　　　当月.Cells(縦, 20).Value = 日
　　　　当月.Cells(縦, 21).Resize(, 7).Value = 登録.Cells(行, 17).Resize(, 7).Value
　　　　縦 = 縦 + 1
　　Next
　　　
　　With 当月
　　　　.Range(.Cells(7, 20), .Cells(縦 - 1, 27)).Sort _
　　　　　　Key1:=.Cells(7, 20), _
　　　　　　Order1:=xlAscending, _
　　　　　　Header:=xlNo, _
　　　　　　Orientation:=xlTopToBottom
　　End With

　　With 登録
　　　　.Range(.Cells(5, 4), .Cells(10, 7)).ClearContents
　　　　.Range(.Cells(12, 4), .Cells(15, 7)).ClearContents
　　　　.Range(.Cells(17, 4), .Cells(24, 7)).ClearContents
　　　　.Range(.Cells(26, 4), .Cells(29, 7)).ClearContents
　　　　.Range(.Cells(5, 11), .Cells(12, 14)).ClearContents
　　　　.Range(.Cells(14, 11), .Cells(19, 14)).ClearContents
　　　　.Range(.Cells(21, 11), .Cells(26, 14)).ClearContents
　　　　.Range(.Cells(7, 18), .Cells(23, 18)).ClearContents
　　End With
　　MsgBox "データ転送が終了しました。", vbOKOnly + vbInformation, "終了"
　　Application.DisplayAlerts = True
　　Application.Calculation = xlCalculationAutomatic
　　　Application.Calculate
　　　Application.ScreenUpdating = True
End Sub

・ツリー全体表示


	【75409】順序よく、エクセルから画像を取り出す

クリプ - 14/3/21(金) 11:35 -


	引用なし

	パスワード

ブックに写真を沢山貼り付け、写真アルバムとして使っています。
全写真をJPEGファイルとして取り出したいとおもいます。
例えば、以下のような方法でできることはできるのですが、
t　tp://zuvuyalink.net/nrjlog/archives/1007
できたJPEGの名前がテキトーなようです。

最も上左に貼り付けてある写真から、順に名前をつけたいと思います。
最も上左にある写真がImage001、
2番目の写真がImage002・・・・といった感じです。

どうぞよろしくお願いいたします。
Windows7でエクセル2010を使っています。

・ツリー全体表示


	【75408】Re:離れた行の行No取得

亜矢 - 14/3/21(金) 10:16 -


	引用なし

	パスワード

▼kanabun さん：
>▼亜矢さん：
>
>> 離れた行を何行か選択した時、その選択した行Noを
>>　取得する方法を教えて頂きたいと思います。選択行数は８行以内です
>
>「離れた行」というのは「連続していない行」ということですか？
>
>どう使うか分からないので、とりあえず、
>行を選択して右クリックすると、選択されている行番号を
>カンマ区切りでメッセージするプロシージャ。
>
>（シートモジュールに書いてください）
>Private Sub Worksheet_BeforeRightClick( _
>　　　 ByVal Target As Range, Cancel As Boolean)
>　　Dim Gyo As Range
>　　Dim i As Long
>　　ReDim LiN(1 To Target.Areas.Count) 'Area数
>　　
>　　Cancel = True
>　　For Each Gyo In Target.Areas
>　　　　i = i + 1
>　　　　LiN(i) = Gyo.Row
>　　Next
>　　MsgBox Join(LiN, ",")
>End Sub
説明不足ですみません。
　連続行の場合は問題なく処理できていますが、Ctrlを押しながら行を
　複数離れて選択した場合の行Noを取得したいと思います。
　　選択が終了するとシート作ってあるコマンドボタンで色色処理を行います。
　　行Noは他の所でその行のデータ（１５列ほど）を使用するために使います。
　よろしくお願いします。

・ツリー全体表示


	【75407】Re:離れた行の行No取得

kanabun - 14/3/21(金) 9:47 -


	引用なし

	パスワード

▼亜矢さん： > 離れた行を何行か選択した時、その選択した行Noを >　取得する方法を教えて頂きたいと思います。選択行数は８行以内です「離れた行」というのは「連続していない行」ということですか？どう使うか分からないので、とりあえず、行を選択して右クリックすると、選択されている行番号をカンマ区切りでメッセージするプロシージャ。（シートモジュールに書いてください） Private Sub Worksheet_BeforeRightClick( _ 　　　 ByVal Target As Range, Cancel As Boolean) 　　Dim Gyo As Range 　　Dim i As Long 　　ReDim LiN(1 To Target.Areas.Count) 'Area数　　　　Cancel = True 　　For Each Gyo In Target.Areas 　　　　i = i + 1 　　　　LiN(i) = Gyo.Row 　　Next 　　MsgBox Join(LiN, ",") End Sub

・ツリー全体表示


	【75406】離れた行の行No取得

亜矢 - 14/3/21(金) 7:41 -


	引用なし

	パスワード

いつもお世話になります。
　エクセル２００７です。離れた行を何行か選択した時、その選択した行Noを
　取得する方法を教えて頂きたいと思います。選択行数は８行以内です
　よろしくお願いします。

・ツリー全体表示


	【75405】［無題］

りんご

- 14/3/21(金) 0:03 -


	引用なし

	パスワード

次のように登録のマクロを組みました。1.登録日と同じデータが当月シートにある場合警告メッセージ、2.当月シートにデータ張付が完了したら日付順に整列させるようにしたいのですが、うまくいきません。構文の不具合もあると思いますが、なかなか解決できません。詳しい方のご指導をお願いいたします。

Sub まとめて登録()

Application.ScreenUpdating = False
　　Application.Calculation = xlCalculationManual
　　Application.DisplayAlerts = False
Set 登録 = Worksheets("登録")
　　　月 = 登録.Cells(4, 18)
　　　日 = 登録.Cells(4, 20)
　　　区分 = 登録.Cells(7, 17)
　　　人数 = 登録.Cells(7, 18)
　　　あ = 登録.Cells(7, 19)
　　　い = 登録.Cells(7, 20)
　　　う = 登録.Cells(7, 21)
　　　え = 登録.Cells(7, 22)
　　　備考 = 登録.Cells(7, 23)

　'最終行を取得（Q23から上方向に牽索）

　最終行 = 登録.Range("Q23").End(xlUp).Row

Set 当月 = Worksheets("登録月" & 月)
　　　縦 = 7
　　 msg = MsgBox("入力内容を登録月" & 月 & "シートに転送します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbExclamation, "入力内容の転送")
　　 If msg = vbOK Then
　　
　　
　If Worksheet.CountIf("当月.Range(当月.cells(7,20).vaiue:当月.cells(400,20).value", 登録.Cells(4, 20).valuw) ＜１ Then
　　　　　
　 msg = MsgBox("この日付データはすでに登録されています " vbOKonly + vbExclamation)
　　
　If msg = vbOK Then

　For 行 = 7 To 最終行
　　

　Do Until 当月.Cells(縦, 20) = ""
　　　縦 = 縦 + 1
　Loop
　　　
　　　当月.Cells(縦, 20) = 日
　　　当月.Cells(縦, 21) = 区分
　　　当月.Cells(縦, 22) = 人数
　　　当月.Cells(縦, 23) = あ
　　　当月.Cells(縦, 24) = い
　　　当月.Cells(縦, 25) = う
　　　当月.Cells(縦, 26) = え
　　　当月.Cells(縦, 27) = 備考
　　　
　　　
　　　For 横 = 17 To 23
　　　　当月.Cells(縦, 横 + 4) = Cells(行, 横)
　　　Next
　　　　
　　
　Next
　　
　With 登録
　　　　.Range(.Cells(5, 4), .Cells(10, 7)).ClearContents
　　　　.Range(.Cells(12, 4), .Cells(15, 7)).ClearContents
　　　　.Range(.Cells(17, 4), .Cells(24, 7)).ClearContents
　　　　.Range(.Cells(26, 4), .Cells(29, 7)).ClearContents
　　　　.Range(.Cells(5, 11), .Cells(12, 14)).ClearContents
　　　　.Range(.Cells(14, 11), .Cells(19, 14)).ClearContents
　　　　.Range(.Cells(21, 11), .Cells(26, 14)).ClearContents
　　　　.Range(.Cells(7, 18), .Cells(23, 18)).ClearContents
　　
　End With

　MsgBox "データ転送が終了しました。", vbOKOnly + vbInformation, "終了"

　Else: MsgBox "操作を中断しました"
　
　　Exit Sub

　
End If
　　Application.DisplayAlerts = True
　　Application.Calculation = xlCalculationAutomatic
　　Application.Calculate
　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【75404】Re:以前作って頂いた物の改変(複雑です)

kanabun - 14/3/20(木) 19:08 -


	引用なし

	パスワード

▼初心者Ｍさん：こんばんは～ >本日社外に出てしまったので、ファイルが手元に有りません。それはかまいません、です。 >１．Ｃ列に台番号「１」が入力された状態のものが５つあって > >２．Ｅ列の上(試作数)が空白、真ん中(製品数)が「19400」、下(特別版)だけ「900」が２個と「840」が3個、というようなものだと、 ↑このご説明が、すでに分かりません。 ----------------------------------------- 　　　Ｃ　　　　Ｄ　　　　Ｅ　　 8　　　　　　　　　　　　　　　　 9　　1　　　　　　　　　19400　　 10　　　　　　　　　　　　 900　　 11　　　　　　　　　　　　　　　　 12　　1　　　　　　　　　　　　　　 13　　　　　　　　　　　　　　　　 14　　　　　　　　　　　　　　　　 15　　1　　　　　　　　　　　　　　 16　　　　　　　　　　　　　　　　 ----------------------------------------- のようなサンプルで示していただくことはできませんか？（E列データに関して、こちらが勘ちがいをしていた可能性があります）

・ツリー全体表示


	【75403】Re:以前作って頂いた物の改変(複雑です)

初心者Ｍ - 14/3/20(木) 17:56 -


	引用なし

	パスワード

▼kanabun さん：

すみません。まず、本日社外に出てしまったので、ファイルが手元に有りません。
実際の数値は来週になりますが、

１．Ｃ列に台番号「１」が入力された状態のものが５つあって

２．Ｅ列の上(試作数)が空白、真ん中(製品数)が「19400」、下(特別版)だけ「900」が２個と「840」が3個、というようなものだと、Ｃ列の最大値を「４」に設定してコードを実行すると

３．最大値合わせ、繰り上げ、Ｄ列に数値が入っていれば緑に変更、が行われる

４．でも、赤に変える部分には引っかかってこない

という状況だと思われます。
セルの番地違いのような、単純ミスではないかと思います。

・ツリー全体表示


	【75402】Re:以前作って頂いた物の改変(複雑です)

kanabun - 14/3/20(木) 17:38 -


	引用なし

	パスワード

▼初心者M さん：入れ違いで、レスをいただいていたようです m(_ _)m >私の使っているシートでは、数値はある程度揃っているので、実は一切数値をいじらないセルも有るのです。 ↑すみません。どういうことか、分りません。　簡単な例を示していただけないでしょうか？ >とりあえず分かったことは、上にも書きましたが、それぞれの項目の、数値をバラバラにすると上手くカウントされるようだということです。 > >元々の表が「特別版」だけ数が微妙に違うなど、大した差のないデータであるため、このようになったのかな？と想像しています。 >kanabunさんのコードで生成される表では数値がバラバラですよね。それで上手く動いているので、とりあえずそのような原因しか今のところ思い当たりませんでした。 ↑再度、すみませんm(_ _)m 頭が固く、分りません。　簡単な例を示していただけないでしょうか？

・ツリー全体表示


	【75401】計算式の答え　均等割り付け

（´・ω・`） - 14/3/20(木) 15:51 -


	引用なし

	パスワード

いつもお世話になっております。
VBじゃないかもですが、、、
計算式の答えを均等割り付けしたい場合は
どうしたらよいですか？？
=today()を均等割りしたいです。
宜しくお願いします

・ツリー全体表示


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

350 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free