[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フラグを、立てたとこだけ別シートへ書き出したい』(さなえ)
初めまして。
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
今のコードだと、「1」を入れたその列のみ取り出される?
それとも、何か違うのでしょうか??
(さなえ) 2016/09/24(土) 20:23
この表があるシートのレイアウトは、こんな感じで想像していました。 ・A列は3行ずつ結合 ・表には空白セルはない
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を記入予定
これは、1ブロック転記の場合は、3セルに入力しますか
(マナ) 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) '1ブロックは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(じゃなくてもいいのですが)が、正しい行(3行の塊の最初の行)に記載されている、 それ以外のセルは【本当の空白】という前提です。
列数、行数ともに、実際のものを動的に取得します。 できあがりが 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列」から始まるのでそのあたりの変更はありません)
なので、マナさんのコードでフラグ「1」を立てたところが「A5」セルからコピー出来たら
いいのかなと思いました。
もしくは、βさんのコードで「A1」〜「A4」までに入っているところもそのままコピーされて
「A5」からフラグ「1」を立てたものだけがコピーされたらいいなとおもったのですが・・・。
(さなえ) 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
これだけはおさえるセル操作(2)−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
3行目がタイトル行、5行目からデータ行で、必要な塊の先頭行のA列にフラッグがあるということは 項目行は4行目でしょうかね?
では、アップしたコードの
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.