Excel VBA質問箱 IV

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

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


49 / 13292 ツリー ←次へ | 前へ→

【80531】ユーザ名を比較して、存在していないユーザを補完したい amatsuno 19/2/28(木) 13:52 質問[未読]

【80543】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/1(金) 19:39 発言[未読]
【80544】Re:ユーザ名を比較して、存在していないユ... amatsuno 19/3/1(金) 19:52 発言[未読]
【80545】Re:ユーザ名を比較して、存在していないユ... amatsuno 19/3/1(金) 19:56 発言[未読]
【80546】Re:ユーザ名を比較して、存在していないユ... でれすけ 19/3/1(金) 20:24 発言[未読]
【80551】Re:ユーザ名を比較して、存在していないユ... amatsuno 19/3/4(月) 9:12 お礼[未読]
【80547】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/1(金) 21:39 発言[未読]
【80552】Re:ユーザ名を比較して、存在していないユ... amatsuno 19/3/4(月) 9:44 回答[未読]
【80555】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/4(月) 19:45 発言[未読]
【80558】Re:ユーザ名を比較して、存在していないユ... amatsuno 19/3/7(木) 10:26 お礼[未読]
【80560】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/7(木) 20:16 発言[未読]
【80550】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/2(土) 15:59 発言[未読]
【80561】Re:ユーザ名を比較して、存在していないユ... マナ 19/3/7(木) 21:48 発言[未読]

【80543】Re:ユーザ名を比較して、存在していない...
発言  マナ  - 19/3/1(金) 19:39 -

引用なし
パスワード
   ▼amatsuno さん:

>vlookupなどを使用する感じでしょうか?

はい。

【80544】Re:ユーザ名を比較して、存在していない...
発言  amatsuno  - 19/3/1(金) 19:52 -

引用なし
パスワード
   ▼マナ さん:
>▼amatsuno さん:
>
>>vlookupなどを使用する感じでしょうか?
>
>はい。


すいません。
正確にはこのような感じです

シート1:
カラムA,カラムB,カラムC

NAME-1,00:22:22
NAME-1.00:33:33
NAME-2,AAAA
NAME-3,00:12:34
NAME-4,00:23:33
NAME-5,00:55:16
NAME-5,00:17:27
NAME-5,00:55:16
NAME-6,HHHHH

シート2: ⇒シート1から抽出
カラムA,カラムB

NAME-1,00:55:55
NAME-3,00:12:34
NAME-4,00:23:33
NAME-5,02:07:59

※カラムAはシート1のカラムCが時間を持っているユーザ
※カラムBはシート1のカラムCの合計値

実行結果
シート3:
カラムA,カラムB

NAME-1,00:55:55
NAME-2,23:59:58
NAME-3,00:12:34
NAME-4,00:23:33
NAME-5,03:30:30
NAME-6,02:07:59


1)シート3のA列(NAME-*)は、シート1と同じ並びで出力させたいです
2)シート3のB列(**:**:**)は、シート2で存在しているユーザーはシート2のB列を、シート2に存在していないユーザーは、「23:59:58」を入れたいと考えています


お手数であはありますが、お分かりになられる方、よろしくお願いいたします

【80545】Re:ユーザ名を比較して、存在していない...
発言  amatsuno  - 19/3/1(金) 19:56 -

引用なし
パスワード
   ▼amatsuno さん:
>▼マナ さん:
>>▼amatsuno さん:
>>
>>>vlookupなどを使用する感じでしょうか?
>>
>>はい。
>
>
>すいません。
>正確にはこのような感じです
>
>シート1:
>カラムA,カラムB,カラムC
>
>NAME-1,00:22:22
>NAME-1.00:33:33
>NAME-2,AAAA
>NAME-3,00:12:34
>NAME-4,00:23:33
>NAME-5,00:55:16
>NAME-5,00:17:27
>NAME-5,00:55:16
>NAME-6,HHHHH
>
>シート2: ⇒シート1から抽出
>カラムA,カラムB
>
>NAME-1,00:55:55
>NAME-3,00:12:34
>NAME-4,00:23:33
>NAME-5,02:07:59
>
>※カラムAはシート1のカラムCが時間を持っているユーザ
>※カラムBはシート1のカラムCの合計値
>
>実行結果
>シート3:
>カラムA,カラムB
>
>NAME-1,00:55:55
>NAME-2,23:59:58
>NAME-3,00:12:34
>NAME-4,00:23:33
>NAME-5,03:30:30
>NAME-6,02:07:59
>
>
>1)シート3のA列(NAME-*)は、シート1と同じ並びで出力させたいです
>2)シート3のB列(**:**:**)は、シート2で存在しているユーザーはシート2のB列を、シート2に存在していないユーザーは、「23:59:58」を入れたいと考えています
>
>
>お手数であはありますが、お分かりになられる方、よろしくお願いいたします


で、上記の条件に対して

 With Worksheets("シート1")
   For i3 = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
     vK2 = .Cells(i3, "A").Value
     dic2(vK2) = dic2(vK2) + .Cells(i3, "B")
   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("シート2")
   With .Range("A1").Resize(i3, 2)
     .EntireColumn.ClearContents
     .Value = vA3
     .Columns(2).NumberFormatLocal = "h:mm:ss"
     Application.Goto .Cells(1), True
   End With
  End With
  Application.ScreenUpdating = True

  Rows(1).Insert

まで実施しました。
このときのシート1にあってシート2にいないユーザの追加の箇所でとまりました

とりあえずvlookupで試してみます

【80546】Re:ユーザ名を比較して、存在していない...
発言  でれすけ  - 19/3/1(金) 20:24 -

引用なし
パスワード
   こんにちわ

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

【80547】Re:ユーザ名を比較して、存在していない...
発言  マナ  - 19/3/1(金) 21:39 -

引用なし
パスワード
   ▼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

【80550】Re:ユーザ名を比較して、存在していない...
発言  マナ  - 19/3/2(土) 15:59 -

引用なし
パスワード
   ▼amatsuno さん:

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

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

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

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

【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


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

【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列です

【80555】Re:ユーザ名を比較して、存在していない...
発言  マナ  - 19/3/4(月) 19:45 -

引用なし
パスワード
   ▼amatsuno さん:

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

そうであれば、

vk2 = c.Offset(, 2).Text

ですね。

【80558】Re:ユーザ名を比較して、存在していない...
お礼  amatsuno  - 19/3/7(木) 10:26 -

引用なし
パスワード
   ▼マナ さん:
>▼amatsuno さん:
>
>>合計するのは、シート1のB列です
>
>そうであれば、
>
>vk2 = c.Offset(, 2).Text
>
>ですね。

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

【80560】Re:ユーザ名を比較して、存在していない...
発言  マナ  - 19/3/7(木) 20:16 -

引用なし
パスワード
   ▼amatsuno さん:

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

【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

49 / 13292 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free