[[20090903112929]]　『入力があった行のセルのみ、別シートにコピーする』（くま）　ページの最後に飛ぶ

『入力があった行のセルのみ、別シートにコピーする方法を教えて下さい』（くま）

 例えば、sheet1で

 Ａ列にグループ名（縦にセル結合しています）、
 Ｂ列に名前、
 Ｃ列に個数
 を入力できる表があるとします。

 Ａ列、Ｂ列は、すでに固定で入力がされおり、追加入力はありません。

 Ｃ列に個数が入力された行のみ、
 グループ名と名前をsheet2の
 Ａ列、Ｂ列にそれぞれ表示をしたいと考えています。

 IFとVLOOKUPでできるかと考えたのですが、
 私の知識では、希望通りには、できませんでした。

 過去ログを見ても合致するのを見つけられなかったので、
 どなたかご教授いただけませんでしょうか。

 特にリアルタイムで、反映する必要はなく、
 ボタン等を作成して、クリックした際に反映する方式でも構いません。

 宜しくお願い致します。

 Sheet2!A1=IF(Sheet1!C1="","",Sheet1!A1)
 で、縦横フィル
 (x-men)

 x-men様、早々にご回答ありがとうございます。

 確かにその方法であれば、簡単にできますね。
 しかしながら、申し訳ございません。説明不足でした。

 このファイルは、多数の人が使う予定ですので、
 できれば、フィルタは使わずに（できるだけ操作をさせずに）
 処理したいのです。

 数だけ入力して、シートを変えたら、
 一覧表ができていると言った感じで・・・

 他に良い方法があれば、ご教授宜しくお願い致します。

 （くま）

 フィルタは使ってませんし、数式を予めいれておけば全部表示されますが？
 それとも、空白は詰めて上から表示させるという事ですか？
 (x-men)

 こういう事ですかね？

 'Sheet2オブジェクトモジュール
 Private Sub Worksheet_Activate()
 Dim v, vv(), i As Long, j As Long, c As Long
 v = Worksheets("Sheet1").Range("A1").CurrentRegion.Value
 c = Application.CountA(Worksheets("Sheet1").Columns("C"))
 ReDim vv(1 To c, 1 To 2)
 j = 1
 For i = 1 To UBound(v)
   If v(i, 3) <> "" Then
     vv(j, 1) = v(i, 1): vv(j, 2) = v(i, 2)
     j = j + 1
   End If
 Next i
 Me.Range("A1").Resize(c, 2).Value = vv
 End Sub

 (x-men)

 x-men様

 そうです。やりたかった事ができました！！
 本当にありがとうございます。
 すごいですね。
 こんなのとてもじゃないですが、私のレベルでは、
 思いつきませんでした。
 ＥＸＣＥＬって、本当に奥が深いと感じました。

 ただ、sheet1のＡ列の結合されたセルを
 sheet2のＡ列に持ってくる際に
 それぞれの行に同じ内容を表示するか、もしくはsheet2でも結合して表示する事は、
 やっぱり難しいですよね？

 （くま）

 こういう事をやりたい時に結合セルがあるのはナンセンスだと思いますね。
 ＶＢＡでも結合セルの処理は重くなりますし、それだけの為に色々な処理を
 しなければならないです。

 とはいえ、サンプルコードです。

 'Sheet2オブジェクトモジュール
 Private Sub Worksheet_Activate()
 Dim v, vv(), i As Long, j As Long, c As Long
 Dim myCol As New Collection, r As Range
 With Application
   .DisplayAlerts = False 　'修正
   .ScreenUpdating = False　'修正
 End With
 With Worksheets("Sheet2").Columns("A:B") '追加
   .ClearContents                         '追加
   .UnMerge                               '追加
 End With　　　　　　　　　　　　　　　　 '追加
 With Worksheets("Sheet1").Range("A1").CurrentRegion
   For Each r In .Columns("A").Cells
     If r.MergeCells Then
       Set rr = r.MergeArea
       myCol.Add rr
       st = r.Value
       rr.UnMerge
       rr.Value = st
     End If
   Next r
   v = .Value
   For Each r In myCol
     r.Merge
   Next r
 End With
 c = Application.CountA(Worksheets("Sheet1").Columns("C"))
 ReDim vv(1 To c, 1 To 2)
 j = 1
 For i = 1 To UBound(v)
   If v(i, 3) <> "" Then
     vv(j, 1) = v(i, 1): vv(j, 2) = v(i, 2)
     j = j + 1
   End If
 Next i
 Me.Range("A1").Resize(c, 2).Value = vv
 For i = 2 To c
   If vv(i - 1, 1) = vv(i, 1) Then _
     Me.Range("A" & i - 1 & ":A" & i).Merge
 Next i
 With Application
   .DisplayAlerts = True
   .ScreenUpdating = True
 End With
 End Sub

 (x-men) 一部修正　16:44

 x-men様

 本当に、本当に、ありがとうございます。
 素晴らしいです。

 確かにコードがこれだけ長くなっているのを見ると
 結合セル、ナンセンスな感じですね。

 でも入力表の方も、実はお客様に提出するフォームであったりするので、
 見栄えという点も重要であり、正直、難しい所ですね。

 このように解決ができて（しかも短時間で）、
 本当に助かりました。
 今後、色々と参考にさせていただきますね。

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

 （くま）

コメント返信：

[ 一覧(最新更新順) ]

[[20090903112929]] 『入力があった行のセルのみ、別シートにコピーする』（くま） ページの最後に飛ぶ

[[20090903112929]]　『入力があった行のセルのみ、別シートにコピーする』（くま）　ページの最後に飛ぶ