Excel VBA質問箱 IV

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

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


9283 / 13644 ツリー ←次へ | 前へ→

【27980】3段組のデータを2段組に仕上げる YN62 05/8/25(木) 21:13 質問[未読]
【27984】Re:3段組のデータを2段組に仕上げる kobasan 05/8/25(木) 22:03 回答[未読]
【27990】Re:3段組のデータを2段組に仕上げる YN62 05/8/25(木) 23:37 お礼[未読]
【28034】Re:3段組のデータを2段組に仕上げる YN62 05/8/26(金) 22:02 質問[未読]
【28035】Re:3段組のデータを2段組に仕上げる kobasan 05/8/26(金) 22:38 回答[未読]
【28037】Re:3段組のデータを2段組に仕上げる kobasan 05/8/26(金) 23:06 発言[未読]
【28042】Re:3段組のデータを2段組に仕上げる YN62 05/8/27(土) 8:09 質問[未読]
【28045】Re:3段組のデータを2段組に仕上げる kobasan 05/8/27(土) 10:21 回答[未読]
【28091】Re:3段組のデータを2段組に仕上げる YN62 05/8/28(日) 15:25 お礼[未読]
【28105】Re:3段組のデータを2段組に仕上げる kobasan 05/8/28(日) 22:11 発言[未読]
【28141】Re:3段組のデータを2段組に仕上げる YN62 05/8/29(月) 20:16 質問[未読]
【28143】Re:3段組のデータを2段組に仕上げる kobasan 05/8/29(月) 21:08 回答[未読]
【28232】Re:3段組のデータを2段組に仕上げる YN62 05/8/31(水) 21:04 お礼[未読]

【27980】3段組のデータを2段組に仕上げる
質問  YN62  - 05/8/25(木) 21:13 -

引用なし
パスワード
   シート1の三段組のデータを
シート2に二段組のデータに仕上げたく思っています。

シート1の行は30行くらいです。

シート1と2の合計欄にはシート関数(Σ)が入っています。

シート1
氏名 点数1    氏名 点数1    氏名 点数 1    
AAA   5    FFF  4      YYY  5    
CCC   7    GGG  3      OOO  6    
BBB   8    KKK  7      PPP  10    
DDD   8    SSS  6      RRR  4    
合計  29    合計  20     合計  25    

シート2
    A    B    C    D    E    F
1    氏名  点数1 点数2  氏名  点数1  点数 2
2    AAA    5       KKK    7    
3    CCC    7       RRR    4    
4    DDD    8       OOO    6    
5    BBB    10        RRR    4    
6    GGG    3       SSS    6    
7    FFF    4                
8    合計   37    0   合計   27    0

※氏名の順番は、シート1とシート2は異なります。
※シート2には氏名PPPはこの集計にはたまたま有りませんでした    
※点数2はシート1と同じような別のデータがあり、同じようにこのシートの氏名を基準に順次貼り付けてシート2の完成です。


自分なりにマクロのコードを書きましたが、列がまたがってくるとどのように書けばよいのか分かりません。ご指導の程お願いいたします。


Sub 異なる表組みへの転記()

Dim k As Integer
Dim R As Range
Dim MyR As Range

For k = 2 To 31

Set MyR = Range(("A4"), Cells(65536, 1).End(xlUp))
For Each R In MyR
If R.Value = Sheets(2).Cells(k, 1).Value Then
Sheets(2).Cells(k, 1).Offset(, 1).Value = R.Offset(, 1).Value

End If

Next
Next

End Sub

【27984】Re:3段組のデータを2段組に仕上げる
回答  kobasan  - 05/8/25(木) 22:03 -

引用なし
パスワード
   ▼YN62 さん 今晩は
これでできると思います

Sheet2 で RRR が重複しているのが気になりますが、
試してみてください。

Sub 異なる表組みへの転記()
Dim k As Integer
Dim r1 As Range, r2 As Range
Dim 範囲11 As Range, 範囲12 As Range, 範囲13 As Range
Dim 範囲21 As Range, 範囲22 As Range
Dim UnionRng1 As Range, UnionRng2 As Range
  '
  With Sheets("Sheet1")
    Set 範囲11 = .Range("A4", .Cells(65536, "A").End(xlUp).Offset(-1))
    Set 範囲12 = .Range("C4", .Cells(65536, "C").End(xlUp).Offset(-1))
    Set 範囲13 = .Range("E4", .Cells(65536, "E").End(xlUp).Offset(-1))
  End With
  With Sheets("Sheet2")
    Set 範囲21 = .Range("A2", .Cells(65536, "A").End(xlUp).Offset(-1))
    Set 範囲22 = .Range("D2", .Cells(65536, "D").End(xlUp).Offset(-1))
  End With
  '
  Set UnionRng1 = Union(範囲11, 範囲12, 範囲13)
  Set UnionRng2 = Union(範囲21, 範囲22)
  '
  For Each r1 In UnionRng1
  For Each r2 In UnionRng2
    If r1.Value = r2.Value Then
      r2.Offset(, 1).Value = r1.Offset(, 1).Value
    End If
  Next
  Next
  '
  Set 範囲11 = Nothing
  Set 範囲12 = Nothing
  Set 範囲13 = Nothing
  Set UnionRng1 = Nothing
  Set UnionRng2 = Nothing
End Sub


>シート1の三段組のデータを
>シート2に二段組のデータに仕上げたく思っています。
>
>シート1の行は30行くらいです。
>
>シート1と2の合計欄にはシート関数(Σ)が入っています。
>
>シート1
>氏名 点数1    氏名 点数1    氏名 点数 1    
>AAA   5    FFF  4      YYY  5    
>CCC   7    GGG  3      OOO  6    
>BBB   8    KKK  7      PPP  10    
>DDD   8    SSS  6      RRR  4    
>合計  29    合計  20     合計  25    
>
>シート2
>    A    B    C    D    E    F
>1    氏名  点数1 点数2  氏名  点数1  点数 2
>2    AAA    5       KKK    7    
>3    CCC    7       RRR    4    
>4    DDD    8       OOO    6    
>5    BBB    10        RRR    4    
>6    GGG    3       SSS    6    
>7    FFF    4                
>8    合計   37    0   合計   27    0
>
>※氏名の順番は、シート1とシート2は異なります。
>※シート2には氏名PPPはこの集計にはたまたま有りませんでした    
>※点数2はシート1と同じような別のデータがあり、同じようにこのシートの氏名を基準に順次貼り付けてシート2の完成です。
>
>
>自分なりにマクロのコードを書きましたが、列がまたがってくるとどのように書けばよいのか分かりません。ご指導の程お願いいたします。
>
>
>Sub 異なる表組みへの転記()
>
>Dim k As Integer
>Dim R As Range
>Dim MyR As Range
>
>For k = 2 To 31
>
>Set MyR = Range(("A4"), Cells(65536, 1).End(xlUp))
>For Each R In MyR
>If R.Value = Sheets(2).Cells(k, 1).Value Then
>Sheets(2).Cells(k, 1).Offset(, 1).Value = R.Offset(, 1).Value
>
>End If
>
>Next
>Next
>
>End Sub

【27990】Re:3段組のデータを2段組に仕上げる
お礼  YN62  - 05/8/25(木) 23:37 -

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

早速ご解答ありがとうございます。
Unionの使い方には、感激です。
未だ、この部分の理解が出来ませんが。
非常に勉強になりました。巷にこの種のワークが結構あるものですから
早速活用が出来そうです。ありがとうございました。

失礼します。

【28034】Re:3段組のデータを2段組に仕上げる
質問  YN62  - 05/8/26(金) 22:02 -

引用なし
パスワード
   又、質問で申し訳けありません。

ご解答いただいたコードの続きですが・・・
シート2が異なるブックにある場合に、コードをどのように
書けば良いのでしょうか?

シート2が「集計」というホルダ−の「得点1」と言うブックに
あると仮定した場合のコードを教えていただけませんでしょうか。

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

【28035】Re:3段組のデータを2段組に仕上げる
回答  kobasan  - 05/8/26(金) 22:38 -

引用なし
パスワード
   ▼YN62 さん 今晩は。

確かめてないのですが、これでできると思います。

Sub 異なる表組みへの転記()
Dim k As Integer
Dim r1 As Range, r2 As Range
Dim 範囲11 As Range, 範囲12 As Range, 範囲13 As Range
Dim 範囲21 As Range, 範囲22 As Range
Dim UnionRng1 As Range, UnionRng2 As Range

  'ブックを見えないようにする
  Application.ScreenUpdating = False
  destFolder = "c:\集計" '<===============環境に合わせて変更してください
  Workbooks.Open Filename:=destFolder & "\得点1.xls"
  ThisWorkbook.Activate
  '
  With ThisWorkbook.Sheets("Sheet1")
    Set 範囲11 = .Range("A4", .Cells(65536, "A").End(xlUp).Offset(-1))
    Set 範囲12 = .Range("C4", .Cells(65536, "C").End(xlUp).Offset(-1))
    Set 範囲13 = .Range("E4", .Cells(65536, "E").End(xlUp).Offset(-1))
  End With
  With Workbooks("得点1").Sheets("Sheet2")
    Set 範囲21 = .Range("A2", .Cells(65536, "A").End(xlUp).Offset(-1))
    Set 範囲22 = .Range("D2", .Cells(65536, "D").End(xlUp).Offset(-1))
  End With
  '
  Set UnionRng1 = Union(範囲11, 範囲12, 範囲13)
  Set UnionRng2 = Union(範囲21, 範囲22)
  
  'UnionRng2.Offset(, 1).ClearContents
  '
  For Each r1 In UnionRng1
  For Each r2 In UnionRng2
    If r1.Value = r2.Value Then
      r2.Offset(, 1).Value = r1.Offset(, 1).Value
    End If
  Next
  Next
  '
  Workbooks("得点1").Close False
  '
  Set 範囲11 = Nothing
  Set 範囲12 = Nothing
  Set 範囲13 = Nothing
  '
  Set 範囲21 = Nothing
  Set 範囲22 = Nothing
  Set UnionRng1 = Nothing
  Set UnionRng2 = Nothing
End Sub


>又、質問で申し訳けありません。
>
>ご解答いただいたコードの続きですが・・・
>シート2が異なるブックにある場合に、コードをどのように
>書けば良いのでしょうか?
>
>シート2が「集計」というホルダ−の「得点1」と言うブックに
>あると仮定した場合のコードを教えていただけませんでしょうか。
>
>よろしくお願いいたします。

【28037】Re:3段組のデータを2段組に仕上げる
発言  kobasan  - 05/8/26(金) 23:06 -

引用なし
パスワード
   一部、訂正です。

>  Workbooks("得点1").Close False


  Workbooks("得点1").Close true  'メッセージなしで保存

にしてください。

【28042】Re:3段組のデータを2段組に仕上げる
質問  YN62  - 05/8/27(土) 8:09 -

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

ご解答ありがとうございます。

この部分でエラーが発生しています。
 Application.ScreenUpdating = False
  destFolder = "C:\WINDOWS\デスクトップ\集計" '<===============環境に合わせて変更してください
  Workbooks.Open Filename:=destFolder & "\得点1.xls"

デスクトップ上で動作させていますが、パスも正しいのですが・・・
エラーがworkbooks.openのところで発生してしまいます。
「実行時エラー1004」です。ファイルが見つからない、保存場所が異なるか
というアラームです。

これだけでは分かりにくいでしょうが・・・workbooksが特定できていません。
何か気づきの点が有りましたら、教えてください。

【28045】Re:3段組のデータを2段組に仕上げる
回答  kobasan  - 05/8/27(土) 10:21 -

引用なし
パスワード
   ▼YN62 さん 今日は。
デスクトップのパスはWindowsのバージョンによって、たとえば、

Meの時 C:\WINDOWS\デスクトップ
XPの時  C:\Documents and Settings\kobasan\デスクトップ

のように異なります。デスクトップ上のフォルダやファイルのパスは気をつける必要があります。
従って、デスクトップに特定するのなら、次のように変更したください。

>destFolder = "C:\WINDOWS\デスクトップ\集計" '<=======環境に合わせて変更してください

destFolder = deskTopPath & "\集計" '<=============環境に合わせて変更してください

に変えて、

Private Function deskTopPath() As String
Dim WsShell As Object
  Set WsShell = CreateObject("WScript.Shell")
  deskTopPath = WsShell.SpecialFolders("Desktop")
  Set WsShell = Nothing
End Function

を前回のマクロと同じ標準モジュールに追加してください。

デスクトップのパスはFunction deskTopPathで調べています。

私はこのような場合、柔軟性を持たせるため、
マクロを含むBookと転記先のブックを同じフォルダに入れて、
destFolder = Thisworkbook.Path 
としています。

試してみてください。

>この部分でエラーが発生しています。
> Application.ScreenUpdating = False
>  destFolder = "C:\WINDOWS\デスクトップ\集計" '<===============環境に合わせて変更してください
>  Workbooks.Open Filename:=destFolder & "\得点1.xls"
>
>デスクトップ上で動作させていますが、パスも正しいのですが・・・
>エラーがworkbooks.openのところで発生してしまいます。
>「実行時エラー1004」です。ファイルが見つからない、保存場所が異なるか
>というアラームです。
>
>これだけでは分かりにくいでしょうが・・・workbooksが特定できていません。
>何か気づきの点が有りましたら、教えてください。

【28091】Re:3段組のデータを2段組に仕上げる
お礼  YN62  - 05/8/28(日) 15:25 -

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

ありがとうございました。
ご指摘の

柔軟性を持たせるため、
マクロを含むBookと転記先のブックを同じフォルダに入れて、
destFolder = Thisworkbook.Path 
としています。
試してみてください。

に変更して全て上手く行きました。

>デスクトップのパスはWindowsのバージョンによって、たとえば、
>Meの時 C:\WINDOWS\デスクトップ
>XPの時  C:\Documents and Settings\kobasan\デスクトップ
>のように異なります。デスクトップ上のフォルダやファイルのパスは気をつける必要があります。

98を使っています。Meと同じパスです。

>従って、デスクトップに特定するのなら、次のように変更したください。
>>destFolder = "C:\WINDOWS\デスクトップ\集計" '<=======環境に合わせて変更してください
>を
>destFolder = deskTopPath & "\集計" '<=============環境に合わせて変更してください
>
>に変えて、

上記コードに変えましたが、
With Workbooks("得点1.xls").Sheets(1)で
実行時エラー9が出ます。

destFolder = Thisworkbook.Pathを
採用させていただき、使います。
>
>Private Function deskTopPath() As String
>Dim WsShell As Object
>  Set WsShell = CreateObject("WScript.Shell")
>  deskTopPath = WsShell.SpecialFolders("Desktop")
>  Set WsShell = Nothing
>End Function
>
>を前回のマクロと同じ標準モジュールに追加してください。
>
>デスクトップのパスはFunction deskTopPathで調べています。
>

ともあれ、無事解決できました。ありがとうございました。

お礼が遅くなりました。試行錯誤し、なかなか上手くいかなかったもの
ですから遅くなりました。
失礼します。

【28105】Re:3段組のデータを2段組に仕上げる
発言  kobasan  - 05/8/28(日) 22:11 -

引用なし
パスワード
   ▼YN62 さん 今晩は。

> With Workbooks("得点1.xls").Sheets(1)で
>実行時エラー9が出ます。

msgbox Sheets(1).Name

を実行してみてください。
転記先のシート名になっていますか?
Sheets(1)は必ずしも自分が思っているシートになっていないことがありますので、注意が必要です。

次のように

With Workbooks("得点1").Sheets("Sheet2")

としてみてください。シート名を指定すると

destFolder = deskTopPath & "\集計" 

を使っても、エラーは出なくなると思います。確認してみてください。

【28141】Re:3段組のデータを2段組に仕上げる
質問  YN62  - 05/8/29(月) 20:16 -

引用なし
パスワード
   ▼kobasan さん:
大変ありがとうございました。ご丁寧な指導ありがとうございました。

MsgBoxを活用して確認が出来ました。
お蔭様で、全て期待通りのコードが理解できました。
早速、活用させていただきました。ありがとうございます。

少し質問が、また出てきました。

1.clse true について
close trueが単に「閉じる」だけでなく「保存」までされることも
知りました。
これはsaveとquit subの両方の役割をすると理解してさしさわりないでしょうか。

2.error 処理について
Application.ScreenUpdating = False
  destFolder = "C:\WINDOWS\デスクトップ\集計"   
  On Error Resume Next
  Workbooks.Open Filename:=destFolder & "\3段組みを2段組みに.xls"
  On Error GoTo 0
error処理をするとすれば、フォルダー変数の前にしないとトラブルように思えたのですが、これで良いのでしょうか。

時間が許せるようでしたら、ご返事お願いします。
では、失礼します。

【28143】Re:3段組のデータを2段組に仕上げる
回答  kobasan  - 05/8/29(月) 21:08 -

引用なし
パスワード
   ▼YN62 さん 今晩は。

>少し質問が、また出てきました。
>
>1.clse true について
>close trueが単に「閉じる」だけでなく「保存」までされることも
>知りました。
>これはsaveとquit の両方の役割をすると理解してさしさわりないでしょうか。

その理解でいいと思います。
save,quit,Close はヘルプを見てもわかりやすく解説してあります。


>2.error 処理について
>Application.ScreenUpdating = False
>  destFolder = "C:\WINDOWS\デスクトップ\集計"   
>  On Error Resume Next
>  Workbooks.Open Filename:=destFolder & "\3段組みを2段組みに.xls"
>  On Error GoTo 0
>error処理をするとすれば、フォルダー変数の前にしないとトラブルように思えたのですが、これで良いのでしょうか。

On Error GoTo 0 は、以下の行からエラーはないものにするということから、
Workbooks.Open に対するエラー処理に限定したいのなら、これでもいいと思います。

しかし、これではファイルが開きませんので、エラーがあった場合の処理を別に考える必要があります。

それから、ここでエラー処理を入れる必要性は、私にはよく分かりませんので、ご自分でよく確かめながら使ってください。

On Error Resume Nextは、普通、プログラムのはじめの部分に書きます。
この場合、どんなエラーも拾いますから、いったいどこでエラーが起きているのか分かり難くなります。On Error は、エラーが特定できるとき、「そのエラーをうまく利用する」やり方で使った方がいいと思います。短いプログラムで利用するのはエラーを特定しやすいのでいいと思います。しかし、長いプログラムでは利用しない方がいいと思います。

【28232】Re:3段組のデータを2段組に仕上げる
お礼  YN62  - 05/8/31(水) 21:04 -

引用なし
パスワード
   ▼kobasan さん:
色々とご指導ありがとうございました。
今後ともよろしくお願いいたします。

失礼します。

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