[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『回覧簿を作成したい』(よっちゃん)
B1〜K1、B4〜、B7〜
名前
B2〜K1、B5〜、B8〜
空欄
と、なっていて空欄セルは捺印ができる程度の列幅
になっています。
しかし、メンバーが増えてそのたびに変更作業が発生します。
後ろに、追加であれば特に問題ないのですがB1とC1の間に増えて
それ以降の部分がズレる等結構手間です。
部内は、25人程います。
別シートで、メンバー表を作成して追加したい場所へ追加し回覧簿にも
その順番で反映してくれるようなやり方何かありませんか?
関数かマクロで、実現出来たらうれしいのですが。。
宜しくお願い致します。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
お悩みのほうは、詰まっているよくわかりませんが、1、4、7行目にそれぞれ行挿入を行ったうえで、VLOOKUPなどで参照したらどうですか?
「メンバー表」シート ____A_____B______ 1 番号 名前 2 1 あああ 3 2 いいい 4 3 ううう 5 4 えええ 6 5 おおお 7 6 かかか 8 7 ききき 9 8 くくく
表示用のシート ___A_____B_______C______D___.... 1 1 2 3 2 名前 ★ → 3 押印欄 4 5 11 12 13 6 名前 ◆ → 7 押印欄
(1) ★のところに、↓を書き込んで、K列までコピー =VLOOKUP(B1,メンバー表!$A$1:$B$25,2,FALSE)
(2) ◆のところに、B2〜K2を貼付
(3) 1,5,9行目(挿入した行)を非表示にする
(もこな2 ) 2020/08/04(火) 07:40
こんにちは ^^ お望みのフォーマットがよく解りませんでしたので。。。← 私だけ ^^; 恐怖の憶測と推測の域を出ない超エスパー的デモコードですが、ご考察の一助 にでも、なれば幸甚です。外しておりましたらポイしてくださいね。( ̄▽ ̄) 何分、あちこち、消しまくるコードも含んでおりますので、お試の際には、 新規ブックにてお願いいたします。幽霊変数等有るやも知れませんが、何卒お 目こぼしを。m(_ _)m...でわでわ Option Explicit Sub OneInstanceMain() Const zProgramID As String = "IJ00060.xlsm" Dim zTb As Workbook Dim i As Long Dim y As Long Dim x As Long Dim dan As Long Dim retu As Long Dim v() As Variant Dim rn() As Variant Dim t As Double t = Timer zDummymMasterMake dan = 3 retu = 10 Set zTb = Workbooks(zProgramID) With zTb.Worksheets("zXjejeMaster") Intersect(.UsedRange, .Columns("A:B")).Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlNo v = Intersect(.UsedRange, .Columns("A:B")).Value End With ReDim rn(1 To 4 * dan, 1 To 1 * retu) y = 1: i = 1 Do For x = 1 To UBound(rn, 2) rn(y, x) = v(i, 2) i = i + 1 If i > UBound(v, 1) Then Exit Do Next y = y + 4 DoEvents Loop With zTb.Worksheets("Sheet1") .UsedRange.Clear .Cells(1).Resize(UBound(rn, 1), UBound(rn, 2)) = rn .UsedRange.Columns.AutoFit .Activate End With Set zTb = Nothing Erase v, rn MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub Private Sub zDummymMasterMake() Dim sNm As String Dim i As Long Dim v(1 To 25, 1 To 2) As Variant For i = 1 To 25 v(i, 1) = 10000 + i v(i, 2) = "従業員-" & Split(Cells(i).Address, "$")(1) Next sNm = "zXjejeMaster" If Not Evaluate("=ISREF(" & sNm & "!A1)") Then Sheets.Add.Name = sNm With Worksheets(sNm) .UsedRange.Clear .Cells(1).Resize(UBound(v, 1), UBound(v, 2)) = v .UsedRange.Columns.AutoFit End With End Sub (隠居じーさん) 2020/08/04(火) 08:25
(隠居じーさん) 2020/08/04(火) 08:35
'シート名=回覧簿、メンバー表の2シート構成 'メンバー表のA列に氏名列挙 Dim ws1 As Worksheet, ws2 As Worksheet, c As Range, r As Range Set ws1 = Sheets("回覧簿") Set ws2 = Sheets("メンバー表") ws1.Range("B:H").ClearContents Set r = ws1.Range("B1") For Each c In ws2.Range("A:A").SpecialCells(2) r.Value = c.Value If r.Column = 11 Then Set r = r.Offset(3, -9) Else Set r = r.Offset(, 1) End If Next c End Sub (mm) 2020/08/04(火) 09:39
Sub さんぷる() Dim i As Long
With Worksheets("メンバー表") For i = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row Step 10 .Cells(i, "B").Resize(10, 1).Copy
Worksheets("回覧簿").Range("B1").Offset((i \ 10) * 3).PasteSpecial _ Paste:=xlPasteValues, Transpose:=True Next i End With End Sub
(もこな2) 2020/08/04(火) 12:53
コードありがとうございます。
やってみたのですが、希望通りには作成出来るのですが次セルが空白の場合に
コピー範囲とペースト範囲が選択された状態で終了してまいます。
これは、解除した状態で終了するのは無理なのでしょうか???
(よっちゃん) 2020/08/10(月) 15:09
最後にコピーカットモードを解除して、適当なセルを選択すれば可能です。
(いずれもマクロの記録を使えばコードは容易にわかります)
ただ、自分では一切考えたくないということであればマクロはお勧めしません。
メンテナンスできずに泣きつかれても困りますので・・・
(もこな2 ) 2020/08/10(月) 19:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.