[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フラグを、立てたとこだけ別シートへ書き出したい』（さなえ）
初めまして。
B列からH列くらいまである3行おきの表があります。
A列が、空いているのでフラグ用に使用しようと
思ってます。
そして、そのフラグを立てた(1を記入予定)とこの
対象3行を一つとして別シートへ書き出したいと思う
のですがいいやり方が浮かびません。
マクロが、初心者の為よく分からないのでコードを
ご教示願います。
よろしくお願いいたします。
＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞
Option Explicit
Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim tbl As Range
Dim i As Long
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set tbl = ws1.Cells(1, 1).CurrentRegion
ws2.UsedRange.Offset(1).ClearContents
For i = 2 To tbl.Rows.Count Step 3
If tbl.Cells(i, 1).Value = 1 Then
tbl.Cells(i, 2).Resize(3, 7).Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next
End Sub
（マナ） 2016/09/24(土) 15:20
今のコードだと、「１」を入れたその列のみ取り出される？
それとも、何か違うのでしょうか？？
（さなえ） 2016/09/24(土) 20:23
この表があるシートのレイアウトは、こんな感じで想像していました。 ・A列は３行ずつ結合 ・表には空白セルはない
A B C D E F G H 1 item1 item2 item3 item4 item5 item6 item7 2 a11 a12 a13 a14 a15 a16 a17 3 1 a21 a22 a23 a24 a25 a26 a27 4 a31 a32 a33 a34 a35 a36 a37 5 b11 b12 b13 b14 b15 b16 b17 6 1 b21 b22 b23 b24 b25 b26 b27 7 b31 b32 b33 b34 b35 b36 b37 8 c11 c12 c13 c14 c15 c16 c17 9 c21 c22 c23 c24 c25 c26 c27 10 c31 c32 c33 c34 c35 c36 c37 11 d11 d12 d13 d14 d15 d16 d17 12 1 d21 d22 d23 d24 d25 d26 d27 13 d31 d32 d33 d34 d35 d36 d37
（マナ） 2016/09/24(土) 21:11
この意味がわかりません。説明していただけますか。
＞1を記入予定
これは、１ブロック転記の場合は、３セルに入力しますか
（マナ） 2016/09/24(土) 21:51
Option Explicit
Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim c As Range, f As Range, r As Range, u As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws2.UsedRange.Offset(1).ClearContents
Set c = ws1.Columns(1).Find(What:=1, LookIn:=xlValues, LookAt:=xlWhole)
If c Is Nothing Then Exit Sub
Set f = c
Do
Set r = c.Offset(, 1).Resize(3, 7) '１ブロックは３行７列
If u Is Nothing Then
Set u = r
Else
Set u = Union(u, r)
End If
Set c = ws1.Columns(1).FindNext(c)
Loop Until c.Address = f.Address
If Not u Is Nothing Then
u.Copy ws2.Cells(2, 1)
End If
End Sub
（マナ） 2016/09/24(土) 22:45
ちょっと書いてみました。参加賞狙いで。 A列には 1(じゃなくてもいいのですが）が、正しい行（３行の塊の最初の行）に記載されている、 それ以外のセルは【本当の空白】という前提です。
列数、行数ともに、実際のものを動的に取得します。 できあがりが 65536行を超えるならTRANSPOSEの制限で使えなくなりますが。
Sub Sample()
Dim a As Range
Dim r As Range
Dim al As Object
Dim hd As Variant
Set al = CreateObject("System.Collections.ArrayList")
With Sheets("Sheet1").Range("A1").CurrentRegion
hd = .Rows(1).Resize(, .Columns.Count - 1).Offset(, 1)
With .Resize(.Rows.Count - 1).Offset(1)
Set a = Intersect(.Columns("A").SpecialCells(xlCellTypeConstants).EntireRow, .Cells)
For Each r In a.Areas
al.Add r.Resize(, UBound(hd, 2)).Offset(, 1).Value
al.Add r.Resize(, UBound(hd, 2)).Offset(1, 1).Value
al.Add r.Resize(, UBound(hd, 2)).Offset(2, 1).Value
Next
End With
End With
With Sheets("Sheet2")
.UsedRange.ClearContents
.Range("A1").Resize(, UBound(hd, 2)).Value = hd
.Range("A2").Resize(al.Count, UBound(hd, 2)).Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(al.toarray))
End With
End Sub
（β） 2016/09/25(日) 00:10
ちゃんと、提出用様式のフォーマットを確認していなかったので改めて確認してみたところ
「A1」セル：別記様式甲第◎◎号 と記載がありました。
「A3：H3」結合セル：表のタイトル が、ありました。
（↑最終的な提出する時のフォーマットなのでフラグ立ててる作業用シートは
「A列」は、フラグ用なので「B列」から始まるのでそのあたりの変更はありません）
なので、マナさんのコードでフラグ「１」を立てたところが「A5」セルからコピー出来たら
いいのかなと思いました。
もしくは、βさんのコードで「A1」〜「A4」までに入っているところもそのままコピーされて
「A5」からフラグ「１」を立てたものだけがコピーされたらいいなとおもったのですが・・・。
（さなえ） 2016/09/25(日) 10:08
ws2.UsedRange.Offset(4).ClearContents
u.Copy ws2.Cells(5, 1)
（マナ） 2016/09/25(日) 10:22
これだけはおさえるセル操作（1）−Offsetで自由自在 https://www.moug.net/tech/exvba/0050057.html
これだけはおさえるセル操作（２）−Resizeで自由自在 https://www.moug.net/tech/exvba/0050058.html
セル範囲の取得 http://officetanaka.net/excel/vba/cell/cell10.htm
条件に当てはまるセルを検索する(Find/FindNext/FindPreviousメソッド) https://www.moug.net/tech/exvba/0050116.html
条件に一致した複数のセルを選択する（RangeプロパティとUnionメソッド） https://www.moug.net/tech/exvba/0050154.html
セルをコピーする（Copyメソッド） https://www.moug.net/tech/exvba/0050101.html
（マナ） 2016/09/25(日) 10:27
３行目がタイトル行、５行目からデータ行で、必要な塊の先頭行のＡ列にフラッグがあるということは 項目行は４行目でしょうかね？
では、アップしたコードの
hd = .Rows(1).Resize(, .Columns.Count - 1).Offset(, 1)
With .Resize(.Rows.Count - 1).Offset(1)
これを
hd = .Rows(4).Resize(, .Columns.Count - 1).Offset(, 1)
With .Resize(.Rows.Count - 4).Offset(4)
に。
（β） 2016/09/25(日) 19:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.