Excel VBA質問箱 IV

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

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


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

95 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【80569】複数選択したシートに、ページ番号の設定...

わか - 19/3/11(月) 19:41 -


	引用なし

	パスワード

初めまして。マクロ初心者です。
前任者が組んだマクロを参考に初めてマクロに挑戦しています。
うまく行かない作業があるため、どなたかご教授の方よろしくお願い致します。

同一エクセル内の複数あるシートの中で
任意のシートを「手動で選択」し
その後マクロで「ページ番号/総ページ」を設定し
印刷したいのですが、うまく作動できません。

以下、現在の状態です。

1枚にページ設定は入るのですが、全部に設定されません。
印刷は選択したすべてが出ます。

Sub ページ番号設定印刷()
'
' ページ番号設定印刷 Macro
'
With ActiveSheet.PageSetup
　　　　.LeftHeader = ""
　　　　.CenterHeader = ""
　　　　.RightHeader = ""
　　　　.LeftFooter = ""
　　　　.CenterFooter = "&P/&N"
　　　　.RightFooter = ""
　　　　.LeftHeader = ""
　　End With

　　ActiveWindow.SelectedSheets.PrintOut Copies:=1
　　
End Sub

・ツリー全体表示


	【80568】Re:コマンドボタンで記録をしたいのですが

颯太 - 19/3/9(土) 15:08 -


	引用なし

	パスワード

マナさん色々とありがとうございました！帰宅後に早速やってみたら出来ました。検索の方もやってみますね、本当にありがとうございました(^.^)

・ツリー全体表示


	【80567】Re:コマンドボタンで記録をしたいのですが

マナ - 19/3/9(土) 13:32 -


	引用なし

	パスワード

▼颯太さん：

検索すれば、他にもたくさんあります。
わかりやすいところを、さがすとよいです。
検索上手になることが上達の近道です。

www.sejuku.net/blog/34619
www.moug.net/tech/exvba/0050088.html
www.sejuku.net/blog/31704

・ツリー全体表示


	【80566】Re:コマンドボタンで記録をしたいのですが

颯太 - 19/3/9(土) 13:14 -


	引用なし

	パスワード

最近始めたばかりなのですみません。今外出先なので帰宅してから試してみます！コード三種類有って全部違うように見えますけど同じ意味合いなんですね。ありがとうございました

・ツリー全体表示


	【80565】Re:コマンドボタンで記録をしたいのですが

マナ - 19/3/9(土) 12:44 -


	引用なし

	パスワード

▼颯太さん：

＞初心者がこのような質問してすみません。

そういうことであれば、
まずは、単純な固定のセル範囲をコピーするマクロが
先ではないでしょうか。

１）コピー元.Copy 貼り付け先

Range("G8:G50").Copy Range("Z8").End(xlToLeft).Offset(, 1)

　
２）または
コピー元.Copy
貼り付け先.PasteSpecial xlPasteValues

Range("G8:G50").Copy
Range("Z8").End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

３）または
貼り付け先,Value = コピー元.value

Range("Z8").End(xlToLeft).Offset(, 1).Resize(43).Value = _
　　　　Range("G8").Resize(43).Value

・ツリー全体表示


	【80564】Re:コマンドボタンで記録をしたいのですが

颯太 - 19/3/9(土) 11:58 -


	引用なし

	パスワード

▼マナさん：
>▼颯太さん：
>
>>未記録(空白)の列
>
>End(xlToLeft)で、データのある最終列を求めて
>その右横のセルに貼り付けると考えるとよいです。
>右横は、Offset(, 1)になります。
マナさん返信ありがとうございます！コマンドボタンのコードの表示内はどの様に記入したら良いでしょうか？初心者がこのような質問してすみません。

・ツリー全体表示


	【80563】Re:コマンドボタンで記録をしたいのですが

マナ - 19/3/9(土) 11:02 -


	引用なし

	パスワード

▼颯太さん：

>未記録(空白)の列

End(xlToLeft)で、データのある最終列を求めて
その右横のセルに貼り付けると考えるとよいです。
右横は、Offset(, 1)になります。

・ツリー全体表示


	【80562】コマンドボタンで記録をしたいのですが

颯太 - 19/3/9(土) 10:31 -


	引用なし

	パスワード

入力場所がシートのG8:G50でコマンドボタンを押したら隣のH8:H50に記録する様にしたいです。そして同じコマンドボタンでH列が記録状態であったらI列に記録する様にして順番に未記録(空白)の列に順次記録したいです。

・ツリー全体表示


	【80561】Re:ユーザ名を比較して、存在していない...

マナ - 19/3/7(木) 21:48 -


	引用なし

	パスワード

▼amatsuno さん：

「統合」で、重複のないリストを作成し集計できます。
なので、「統合」を使えるようになると、
Dictionaryの出番がちょっとだけ減ります。

複雑なことはできませんが、今回のお題程度であれば、
sheet2もsheet3も、たったこれだけです。

Sub test()
　　Dim rngS As Range
　　Dim rngD As Range
　　
　　Set rngS = Sheets("sheet1").Cells(1).CurrentRegion.Offset(1).Resize(, 2)
　　
　　Set rngD = Sheets("sheet2").Cells(2, 1).Resize(, 2)
　　rngD.CurrentRegion.Offset(1).ClearContents
　　rngD.Consolidate rngS.Address(, , xlR1C1, True), xlSum, False, True
　　On Error Resume Next
　　rngD.CurrentRegion.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
　　On Error GoTo 0
　　
　　Set rngD = Sheets("sheet3").Cells(2, 1).Resize(, 2)
　　rngD.CurrentRegion.Offset(1).ClearContents
　　rngD.Consolidate rngS.Address(, , xlR1C1, True), xlSum, False, True
　　On Error Resume Next
　　rngD.CurrentRegion.SpecialCells(xlCellTypeBlanks).Value = "23:59:58"
　　On Error GoTo 0
　　
End Sub

・ツリー全体表示


	【80560】Re:ユーザ名を比較して、存在していない...

マナ - 19/3/7(木) 20:16 -


	引用なし

	パスワード

▼amatsuno さん：

Sheet2を作成するために
dictionaryを使用しているのであれば
sheet3もdictionaryを使えばよいのに
と思ったのですが、
伝わりませんでしたか…

・ツリー全体表示


	【80559】Re:F列の値が指定のとき、E列を変換したい

マナ - 19/3/7(木) 20:11 -


	引用なし

	パスワード

▼amatsuno さん：

>>この条件に意味ありますか？
>>
>>LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False
>>

質問の意味がわかりませんでしたか？

・ツリー全体表示


	【80558】Re:ユーザ名を比較して、存在していない...

amatsuno - 19/3/7(木) 10:26 -


	引用なし

	パスワード

▼マナさん：
>▼amatsuno さん：
>
>>合計するのは、シート1のB列です
>
>そうであれば、
>
>vk2 = c.Offset(, 2).Text
>
>ですね。

ありがとう財増す。
記載が足りなくて申し訳ございません

・ツリー全体表示


	【80557】Re:F列の値が指定のとき、E列を変換したい

amatsuno - 19/3/7(木) 10:25 -


	引用なし

	パスワード

▼マナさん：
>▼amatsuno さん：
>
>>解決しました
>
>>Set c2 = ActiveSheet.Columns("F:F").Find(What:=MYTXT, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
>
>
>この条件に意味ありますか？
>
>LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False
>
>
>'-------
>別法です。
>
>Option Explicit
>
>Sub test()
>　　Dim r As Range
>　　
>　　Set r = Cells(1).CurrentRegion
>　　
>　　r.Columns("n").Formula = "=if(TEXT(f1,""hh:mm:ss"")=""23:59:58"",""23:59:58"",e1)"
>　　r.Columns("e").Value = r.Columns("n").Value
>　　r.Columns("n").ClearContents
>　
>End Sub

ありがとうございます。
この方法でも確認してみます

・ツリー全体表示


	【80556】Re:F列の値が指定のとき、E列を変換したい

マナ - 19/3/4(月) 20:52 -


	引用なし

	パスワード

▼amatsuno さん：

>解決しました

>Set c2 = ActiveSheet.Columns("F:F").Find(What:=MYTXT, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

この条件に意味ありますか？

LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False

'-------
別法です。

Option Explicit

Sub test()
　　Dim r As Range
　　
　　Set r = Cells(1).CurrentRegion
　　
　　r.Columns("n").Formula = "=if(TEXT(f1,""hh:mm:ss"")=""23:59:58"",""23:59:58"",e1)"
　　r.Columns("e").Value = r.Columns("n").Value
　　r.Columns("n").ClearContents
　
End Sub

・ツリー全体表示


	【80555】Re:ユーザ名を比較して、存在していない...

マナ - 19/3/4(月) 19:45 -


	引用なし

	パスワード

▼amatsuno さん：

>合計するのは、シート1のB列です

そうであれば、

vk2 = c.Offset(, 2).Text

ですね。

・ツリー全体表示


	【80554】Re:F列の値が指定のとき、E列を変換したい

amatsuno - 19/3/4(月) 13:24 -


	引用なし

	パスワード

▼amatsuno さん：
>F列を参照し、F列に指定の文字列があったらE列にF列の値を入力したいと思っています
>
>現在、以下のようなカラム構成になっています
>
>AAA1,BBB1,CCC1,DDD1,0:01:01,10:20:30
>AAA2,BBB2,CCC2,DDD2,0:02:02,10:20:31
>AAA3,BBB3,CCC3,DDD3,0:03:03,10:20:32
>AAA4,BBB4,CCC4,DDD4,0:04:04,10:20:33
>AAA5,BBB5,CCC5,DDD5,0:05:05,10:20:34
>AAA6,BBB6,CCC6,DDD6,0:06:06,23:59:58
>AAA7,BBB7,CCC7,DDD7,0:07:07,10:20:30
>AAA8,BBB8,CCC8,DDD8,0:08:08,23:59:58
>AAA9,BBB9,CCC9,DDD9,0:09:09,10:20:30
>
>このとき、F列が「23:59:58」の行に関しては、E列を「23:59:58」にしたいと思っています
>※下記のように、AAA6とAAA8のE列を23:59:58にしたい
>
>AAA1,BBB1,CCC1,DDD1,0:01:01,10:20:30
>AAA2,BBB2,CCC2,DDD2,0:02:02,10:20:31
>AAA3,BBB3,CCC3,DDD3,0:03:03,10:20:32
>AAA4,BBB4,CCC4,DDD4,0:04:04,10:20:33
>AAA5,BBB5,CCC5,DDD5,0:05:05,10:20:34
>AAA6,BBB6,CCC6,DDD6,23:59:58,23:59:58
>AAA7,BBB7,CCC7,DDD7,0:07:07,10:20:30
>AAA8,BBB8,CCC8,DDD8,23:59:58,23:59:58
>AAA9,BBB9,CCC9,DDD9,0:09:09,10:20:30
>
>下記のコードで書いたのですが、
>AAA6のほうだけが変換されてしまいます。
>どのように修正すればいいのでしょうか？
>
>Dim C As Long
>Dim c2 As Range
>'検索語
>Const MYTXT As String = "23:59:58"
>
>For C = 1 To Cells(Rows.Count, "F").End(xlUp).Row
>Set c2 = ActiveSheet.Columns("F:F").Find(What:=MYTXT, _
>LookIn:=xlValues, _
>LookAt:=xlPart, _
>MatchCase:=False)
>If Not c2 Is Nothing Then
>c2.Offset(0, -1).Value = "23:59:58"
>End If
>Next C

すいません。
解決しました

Dim c2 As Range
'検索語
Const MYTXT As String = "23:59:58"
Dim firstRow As Long
firstRow = 1

Set c2 = ActiveSheet.Columns("F:F").Find(What:=MYTXT, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not c2 Is Nothing Then
　　firstRow = c2.Row
　　Do
　　　　c2.Offset(0, -1).Value = c2.Value
　　　　Set c2 = ActiveSheet.Columns("F:F").FindNext(c2)
　　Loop Until firstRow = c2.Row
End If

・ツリー全体表示


	【80553】F列の値が指定のとき、E列を変換したい

amatsuno - 19/3/4(月) 11:45 -


	引用なし

	パスワード

F列を参照し、F列に指定の文字列があったらE列にF列の値を入力したいと思っています

現在、以下のようなカラム構成になっています

AAA1,BBB1,CCC1,DDD1,0:01:01,10:20:30
AAA2,BBB2,CCC2,DDD2,0:02:02,10:20:31
AAA3,BBB3,CCC3,DDD3,0:03:03,10:20:32
AAA4,BBB4,CCC4,DDD4,0:04:04,10:20:33
AAA5,BBB5,CCC5,DDD5,0:05:05,10:20:34
AAA6,BBB6,CCC6,DDD6,0:06:06,23:59:58
AAA7,BBB7,CCC7,DDD7,0:07:07,10:20:30
AAA8,BBB8,CCC8,DDD8,0:08:08,23:59:58
AAA9,BBB9,CCC9,DDD9,0:09:09,10:20:30

このとき、F列が「23:59:58」の行に関しては、E列を「23:59:58」にしたいと思っています
※下記のように、AAA6とAAA8のE列を23:59:58にしたい

AAA1,BBB1,CCC1,DDD1,0:01:01,10:20:30
AAA2,BBB2,CCC2,DDD2,0:02:02,10:20:31
AAA3,BBB3,CCC3,DDD3,0:03:03,10:20:32
AAA4,BBB4,CCC4,DDD4,0:04:04,10:20:33
AAA5,BBB5,CCC5,DDD5,0:05:05,10:20:34
AAA6,BBB6,CCC6,DDD6,23:59:58,23:59:58
AAA7,BBB7,CCC7,DDD7,0:07:07,10:20:30
AAA8,BBB8,CCC8,DDD8,23:59:58,23:59:58
AAA9,BBB9,CCC9,DDD9,0:09:09,10:20:30

下記のコードで書いたのですが、
AAA6のほうだけが変換されてしまいます。
どのように修正すればいいのでしょうか？

Dim C As Long
Dim c2 As Range
'検索語
Const MYTXT As String = "23:59:58"

For C = 1 To Cells(Rows.Count, "F").End(xlUp).Row
Set c2 = ActiveSheet.Columns("F:F").Find(What:=MYTXT, _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False)
If Not c2 Is Nothing Then
c2.Offset(0, -1).Value = "23:59:58"
End If
Next C

・ツリー全体表示


	【80552】Re:ユーザ名を比較して、存在していない...

amatsuno - 19/3/4(月) 9:44 -


	引用なし

	パスワード

▼マナさん：
>▼amatsuno さん：
>
>よくみると、合計するのが、B列なのかC列なのか混乱しています。
>どっちでしょうか。
>
>
>Option Explicit
>
>Sub test()
>　　Dim dic1 As Object, dic2 As Object
>　　Dim c As Range
>　　Dim vk1 As String, vk2　As String
>　　
>　　Set dic1 = CreateObject("scripting.dictionary")
>　　Set dic2 = CreateObject("scripting.dictionary")
>　
>　　With Worksheets("シート1")
>　　　　　For Each c In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
>　　　　　　 vk1 = c.Value
>　　　　　　 vk2 = c.Offset(, 2).Text
>　　　　　　
>　　　　　　 If IsDate(vk2) Then
>　　　　　　　　dic1(vk1) = dic1(vk1) + TimeValue(vk2)
>　　　　　　　　dic2(vk1) = dic2(vk1) + TimeValue(vk2)
>　　　　　　Else
>　　　　　　　　dic1(vk1) = TimeValue("23:59:58")
>　　　　　　End If
>　　　　Next
>　　　　　
>　　　　.Cells(5).Resize(dic1.Count).Value = Application.Transpose(dic1.keys)
>　　　　.Cells(6).Resize(dic1.Count).Value = Application.Transpose(dic1.items)
>　　　　.Cells(7).Resize(dic2.Count).Value = Application.Transpose(dic2.keys)
>　　　　.Cells(8).Resize(dic2.Count).Value = Application.Transpose(dic2.items)
>　　End With
>　
>End Sub

すいません。
合計するのは、シート1のB列です

・ツリー全体表示


	【80551】Re:ユーザ名を比較して、存在していない...

amatsuno - 19/3/4(月) 9:12 -


	引用なし

	パスワード

▼でれすけさん：
>こんにちわ
>
>Sub test()
>
>　With Worksheets("Sheet3")
>　　 .Cells.ClearContents
>　　 Worksheets("Sheet2").Range("A1").CurrentRegion.Columns(1).Copy .Cells(.Rows.Count, 1).End(xlUp)
>　　 Worksheets("Sheet1").Range("A1").CurrentRegion.Columns(1).Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
>　　 With .Range("A1")
>　　　　.CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
>　　　　strAddr = Worksheets("Sheet2").Range("A1").CurrentRegion.Address(ReferenceStyle:=exlR1C1, external:=True)
>　　　　With .CurrentRegion.Columns(2)
>　　　　　　 .NumberFormatLocal = "hh:mm:ss"
>　　　　　　 .FormulaR1C1 = "=VLOOKUP(RC[-1]," & strAddr & ",2,false)"
>　　　　　　 .Value = .Value
>　　　　　　 .Replace "#N/A", TimeValue("23:59:58")
>　　　　End With
>　　 End With
>　End With
>
>End Sub

ありがとうございます。
いただいたソースを参考にして確認させていただきます

・ツリー全体表示


	【80550】Re:ユーザ名を比較して、存在していない...

マナ - 19/3/2(土) 15:59 -


	引用なし

	パスワード

▼amatsuno さん：

一般機能の「統合」と「ジャンプ」を使う方法もあります。
こんな感じです。

1) sheet1データをSheet2で「統合」：左端列基準で合計
2) 空白セルに「ジャンプ」
3) 行全体を削除
4) sheet1データをSheet3で「統合」：左端列基準で合計
5) 空白セルに「ジャンプ」
6) "23:58:59"を入力

実際のレイアウトが不明なので、
・１行目に共通見出しがあるかどうか
・合計するのがB列なのかC列なのか
で、操作がかわります。

マクロ化することも可能です。

・ツリー全体表示


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

95 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free