[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『別シートへのセル内容の転記（毎月4つ下のセルに転記したい）』（ひなた）
お世話になっております。
コピー元から特定のセルの数値をコピーして、別シートの特定のセルへの貼付けを行いたいです。
コピー元は全社員の社員番号、金額等が1枚のシートに記入されています。
コピー先は社員ごとのシートとなっており、社員番号2の人は2というシートになります。
こちらは社員番号2番の社員のマクロ
Sub 2()
Worksheets("Pay").Range("E15").Copy Worksheets("2").Range("F13:H14")
Worksheets("Pay").Range("E23").Copy Worksheets("2").Range("J13:K14")
End Sub
こちらは社員番号3番の社員用のマクロ
Sub 3()
Worksheets("Pay").Range("G15").Copy Worksheets("3").Range("F13:H14")
Worksheets("Pay").Range("G23").Copy Worksheets("3").Range("J13:K14")
End Sub
上記のマクロが社員分あります。。。
毎月データを転記しますが、貼付け先のセルは4つずつ下にずれて転記しなければならないため、毎月このマクロを変えて実行していました。
貼付け部分だけを記しますと下記のような感じに変更していたということです。
Range("F13:H14") → Range("F17:H18")
Range("J13:K14") → Range("J17:K18")
これを社員分やっていましたが、毎月マクロを更新してセルを変更するのが大変です。。。
なんとか自動で4つ下のセルを取得してペーストできないものかというご相談です。
マクロ初心者ですので、できればご教授いただける場合は解説を少しいただけると助かります。
お手数をおかけいたしますが、よろしくお願いいたします。
＜ 使用 Excel：Excel2007、使用 OS：Windows10 ＞
例えば3月始まりの2月終わりで13→17→21と4ずつ増えていく式であれば
（A1セルに日付が入ってると仮定します）
f〜h
range(cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,6),cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,8)
j〜k
range(cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,10),cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,11)
（げん） 2019/03/15(金) 15:08
Worksheets("Pay").Range("E15").Copy Worksheets("2").Rangerange(cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,6),cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,8)
Worksheets("Pay").Range("E23").Copy Worksheets("2").Range(cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,10),cells(month(cells(1,1).value)+9 mod 12 +1 )*4+1,11)
End Sub
こういうことで合っていますでしょうか？
理解が悪く申し訳ありません・・・。
（ひなた） 2019/03/15(金) 15:35
基準月（年初め）が分かりませんけど、1月始まりとした場合 1月 ・・・・ 0行ずれる（ずれない） 2月 ・・・・ 4行ずれる（ (2-1) × 4 行下がる） 3月 ・・・・ 8行ずれる（ (3-1) × 4 行下がる） ・ ・ ・
ですよね？
社員番号もシート名の部分に反映されれば良さそうですから、こんな感じのアプローチもありなのでは?
Sub めいん()
Dim 処理月 As Long
Dim 社員番号 As String
処理月 = InputBox("何月の処理ですか？")
社員番号 = Format(InputBox("社員番号を入力してください"), "00")
Call 処理部(社員番号, ((処理月 - 1) * 4))
End Sub
'------------------------------------------------------------------
Sub 処理部(シート名 As String, ずれ数 As Long)
With Worksheets("Pay")
.Range("E15").Copy Worksheets(シート名).Range("F13:H14").Offset(ずれ数)
.Range("E23").Copy Worksheets(シート名).Range("J13:K14").Offset(ずれ数)
End With
End Sub
※この程度で十分という意味ではありません。私の分かる範囲での一例です。
※テストしてないのでミスっていたらごめんなさい。
（もこな２） 2019/03/15(金) 15:57
Dim rw As Long
rw = Worksheets("2").Range("F60").End(xlUp).Row + 3
Worksheets("Pay").Range("E15").Copy Worksheets("2").Range("F" & rw & ":H" & rw + 1)
Worksheets("Pay").Range("E23").Copy Worksheets("2").Range("J" & rw & ":K" & rw + 1)
End Sub
（mm） 2019/03/15(金) 16:37
誤 社員番号 = Format(InputBox("社員番号を入力してください"), "00")
正 社員番号 =InputBox("社員番号を入力してください")
に修正してください。
ちなみにFormatの部分では、
「1」という【数値】を入力 →「01」に変換 「12」という【数値】を入力 →「12」に変換
というように、1桁の数値が入力された場合に桁埋めして出力するように設計していました。
（シート名が01、02となっているのと勘違いしていました。）
＞社員番号とシート名はどこで結びついているのでしょうか？
一度、ステップ実行をしてみて、各変数に何が格納されるのかを見ながら研究してみてください。
＞社員番号02と入力した際、シート名も02にしないといけないのでしょうか？
仮に、「社員番号02」と入力されるのであれば、シート名も「社員番号02」でないとダメです。
なお、今回、社員番号を「2」と入力されたのであれば、
(1)Format関数で、「02」に変換される
(2)String型の変数「社員番号」に代入されることにより【文字列】の「02」として保持される
(3)Worksheets(シート名) の「シート名」の部分が「02」という文字列と解釈される
(4)Worksheets("02") に該当するものが存在しないため実行時エラーが発生 ← 今ココ
という状態になっていると推測します。
このほか、
＞ボックスが出てくるタイプ〜
とのことですが、別にInputboxでないとダメな理由はないので、そこは適宜変えてください。
以下蛇足ですが、通常、一人だけの処理というのは無いと思いますから、月はともかくとしてFor〜Nextステートメントなどで社員番号そのものや、別途リストを用意して対象の行番号を増やしながらループさせるというアプローチにすると楽ちんなのではないかと思います。
Sub さんぷる()
Dim 処理月 As Long
Dim 社員番号 As Long
処理月 = InputBox("何月の処理ですか？")
Stop '←ブレークポイントのかわり
'▼社員番号1〜10を連続処理
For 社員番号 = 1 To 10
With Worksheets(CStr(社員番号))
Worksheets("Pay").Range("E15").Copy .Range("F13:H14").Offset((処理月 - 1) * 4)
Worksheets("Pay").Range("E23").Copy .Range("J13:K14").Offset((処理月 - 1) * 4)
End With
Next 社員番号
End Sub
（もこな２） 2019/03/15(金) 18:30
色々とやってみたのですが、For〜文の行にブレークポイントを入れて、社員番号2が選択されていることを確認したあと、上記の行で結合されたセルの一部を変更することはできませんとエラーになってしまいました。
貼付け先が結合セルであることがまずいのでしょうか？
For〜Next構文で社員ごとに毎回マクロを実行しなくてもいいのはとても便利ですね。数字を入れていくとか、そういう単純なことにしか使ったことがないので、大変参考になります。
（ひなた） 2019/03/18(月) 12:00
ひなたさん
それ以前に、もこな２さんのコードでは、常にE15がコピーされていくことになります。
なので、以下について教えてください。
１）Payシートの表構成
今わかっているのは、たぶんこんな感じなんだろうという程度です。
結合セルがあるなら、教えてください。
|[B] |[C]|[D]|[E] |[F]|[G] |[H]|[I] |[J]|[K]
[14]|社員番号|? | | 2| | 3| | 9| | 20
[15]| |100| |\1,000| |\3,000| |\5,000| |\7,000
[16]| | | | | | | | | |
[17]| | | | | | | | | |
[18]| | | | | | | | | |
[19]| | | | | | | | | |
[20]| | | | | | | | | |
[21]| | | | | | | | | |
[22]| | | | | | | | | |
[23]| |200| |\2,000| |\4,000| |\6,000| |\8,000
２）月が替わっても、E15セルを社員番号ごとのシートに張り付ける、という認識でよろしいですね？
３）payシートには月を特定する文字は入っていませんか？
４）社員番号ごとのシート構成を教えてください。
今わかっているのは、F・J列に張り付け、結合セルがあるだろうという推測だけです。
月の始まりもわかっていません。
13行目は何月なんですか？
|[E] |[F] |[G]|[H]|[I]|[J]
[13]|1月？|\9,999| | | |\9,999
[14]| | | | | |
[15]| | | | | |
[16]| | | | | |
[17]|2月？|\1,000| | | |\2,000
[18]| | | | | |
[19]| | | | | |
[20]| | | | | |
５）社員ごとのシート名を教えてください。 Payシートと同じならそれで構いません。 （稲葉） 2019/03/18(月) 12:40
出力先が結合しているという情報とコードから推測するに、
Payシートの「E15」セルの【値】 → 対応する社員番号のシートのF13:H14が【結合されたセル】の【値】にしたい Payシートの「E23」セルの【値】 → 対応する社員番号のシートのJ13:K14が【結合されたセル】の【値】にしたい
ということだったりしませんか？
その場合、【コピー】せず（書式等は貼付の必要が無く）、ただの【転記】でよいのであれば
Sub さんぷる2()
Dim 処理月 As Long
Dim 社員番号 As Long
処理月 = InputBox("何月の処理ですか？")
Stop '←ブレークポイントのかわり
'▼社員番号1〜10を連続処理
For 社員番号 = 1 To 10
With Worksheets(CStr(社員番号))
.Range("F13").Offset((処理月 - 1) * 4).Value = Worksheets("Pay").Range("E15").Value
.Range("J13").Offset((処理月 - 1) * 4).Value = Worksheets("Pay").Range("E23").Value
End With
Next 社員番号
End Sub
のように、結合セルの左上にあたるセルのValueプロパティに、データ元セルのValueプロパティを参照させるというアプローチも使えそうに思います。
（もこな２） 2019/03/18(月) 13:02
すみませんが、「2019/03/18(月) 13:02」のものは無視してください。
（もこな２） 2019/03/18(月) 13:14
今わかっているのは、F・J列に張り付け、結合セルがあるだろうという推測だけです。
月の始まりもわかっていません。
13行目は何月なんですか？
|[E] |[F〜H]|[I]|[J〜K]|
[ 9〜10]|1月 |\9,999| |\8,800|
[11〜12]| | | | |
[13〜14]|2月 |\9,999| |\8,800|
５）社員ごとのシート名を教えてください。→社員番号1桁なので、2、3、5・・・という感じです。
ちなみに4は欠番です。
（ひなた） 2019/03/18(月) 13:22
仰る通り、ただの【転記】です。
元々のマクロもただただ、転記することを目的に社員ごとに作っていたものです。
分かりにくくて申し訳ありません。
参考になるか分からないのですが、コピー元のE15やG15は合計金額で数式が入っています。
でもそれでも単純なマクロでは転記できていました。
（ひなた） 2019/03/18(月) 13:28
１）大まかじゃ困るんですけどぉ・・・ ２）１）５）に準じますが、I列のように飛んで社員番号9（4番が欠員なのですよね？） とかになったりするわけですよね？ すると、1から5まで繰り返すと通常は C,E,G,I,Kになりますが、社員番号4は欠番なので、社員番号5が社員番号4のセル（Iセル）になるわけですよね？ Payシートの社員番号と、シート名の社員番号が一致しているという認識でいいんですか？ ３）それはどのセルですか？ ４）F9:H10が結合されて、1月から始まりということですね。
蛇足ですが、payは請求書の精算かと思ってました。 （稲葉） 2019/03/18(月) 13:41
エラー処理してないですが、こちらでどうでしょう？
B13に「月」が入力されている前提です。
Sub test()
Dim ws As Worksheet
Dim m As Long
Dim c As Long
Set ws = Sheets("Pay")
m = Val(ws.Range("B13").Value) * 4 + 5 '1月×4行＋5行
For c = 3 To ws.Cells(14, Columns.Count).End(xlToLeft).Column Step 2
With Sheets(CStr(ws.Cells(14, c).Value))
.Cells(m, "F").Value = ws.Cells(15, c).Value
.Cells(m, "J").Value = ws.Cells(23, c).Value
End With
Next c
End Sub
Payシート
|[B] |[C] |[D]|[E] |[F]|[G] |[H]|[I] |[J]
[13]|2月 | | | | | | | |
[14]|社員番号| 1| | 2| | 3| | 5|
[15]|金額1 |\1,000| |\2,000| |\3,000| |\4,000|
[16]| | | | | | | | |
[17]| | | | | | | | |
[18]| | | | | | | | |
[19]| | | | | | | | |
[20]| | | | | | | | |
[21]| | | | | | | | |
[22]| | | | | | | | |
[23]|金額2 |\5,000| |\6,000| |\7,000| |\8,000|
社員番号5の人
|[E]|[F] |[G]|[H]|[I]|[J] |[K]|[L]
[9] |1月|\4,000.00| | | |\8,000.00| |
[10]| | | | | | | |
[11]| | | | | | | |
[12]| | | | | | | |
[13]|2月|\4,000.00| | | |\8,000.00| |
[14]| | | | | | | |
[15]| | | | | | | |
[16]| | | | | | | |
[17]|3月| | | | | | |
（稲葉） 2019/03/18(月) 14:04
|[B] |[C]|[D]| [E] |[F]| [G] |[H]| [I] |[J]| [K]
[ 2]|支給年月| | |2019/1 | |2019/1 | | 2019/1 | |2019/1
[15]|社員番号| | | 2| | 3 | | 5| | 6
[15]| | | |\200,000 | |\150,000| |\300,000| |\400,000
[16]| | | | | | | | | |
[…]| | | | | | | | | |
[23]| | | |\ 50,000 | |\ 30,000| |\60,000 | |\80,000
[24]|(X15-X23) | |\150,000 | |\120,000| |\240,000| |\360,000
[25]| | | |\ 5,000 | |\ 3,000| |\ 6,000| |\ 2,000
もう大まかではなく、このままでございます。
２）そもそもPayシートに社員番号4欄はなく、シートも4はございません。
３）各2行目です。（上記の2行目をご参照ください）
４）その通りです。
（ひなた） 2019/03/18(月) 14:06
ん、月ごとにPayが上書き更新されていくと思っていたのですが、 人ごとに支給日が違う場合もあるのですか？（退職とか？） 社員番号2が1月で、社員番号3が2月ってこともあるのですか？
なければ、
m = Val(ws.Range("B13").Value) * 4 + 5 '1月×4行＋5行
この部分、自分でちょっと考えてやってみません？
（稲葉） 2019/03/18(月) 14:11
ありがとうございます。
月ごとに更新で、支給年月日も同じです。余談ですが支給年月日は1列目にドドーンと記載してあります。
あくまでも個人ごとに支給年月が記載してあるだけです。
ちょっと理解しながらやっていきたいと思います、ありがとうございます。
（ひなた） 2019/03/18(月) 14:18
すみません、わからないので質問させてください。
m = Val(ws.Range("B13").Value) * 4 + 5 '1月×4行＋5行
→1か月あたり4行使っているということですよね、+5行がちょっとわかりませんでした
ちなみに、エラーは出ませんでしたが、転記もされませんでした。
お力をお借りできれば助かります。
（ひなた） 2019/03/18(月) 15:45
最初にVal関数の説明と、何をしているか説明して、 最後にたぶんこうだろうという回答載せます。
B13には「1月」という 文字列 が入力されています。 Val関数は http://officetanaka.net/excel/vba/function/Val.htm こっちよんだほうが早いかも。
Val(ws.Range("B13").Value) * 4 + 5
＝Val("1月") * 4 + 5
＝1 * 4 + 5
＝4 + 5
＝9（行目）
（ひなた） 2019/03/18(月) 13:22の回答で、1月は9行目から始まっているとのことなので このようにしました。 B13が「2月」の場合は 2*4+5 =8+5 =13行目 になります。
さて、1列目にドドーンと記載されたデータはもしかして日付型データ（2019/2/1のような）じゃないですかね？ そうすると、Val関数だとたぶん2019とかなので、転記されてないわけじゃなくて、 8081行目に何か書かれていると思います。
じゃあどうすればいいかというと、必要なのは「月」なのでMonth関数を使います。
A1に2019/2/1と入力されていると仮定して
m = Month(ws.Range("A1").Value) * 4 + 5
ではどうでしょう？
（稲葉） 2019/03/18(月) 15:58
ありがとうございます。
Val関数はなんとなく知っていたのですが、どこを取得しているのかわかりませんでした…すみません。
そして、Ctrl+↓で見てみましたが、セルはすべて空白でした・・・、つまり何も書かれていないようです。
一応、Month関数を使うverも実行してみたのですが、変わらずでした・・・
（ひなた） 2019/03/18(月) 16:44
（稲葉） 2019/03/18(月) 14:04 のテスト環境だと問題ないので、あとはご自身で頑張ってもらうしかないですね。 ステップ実行（F8）で一つずつ調べてみてください。
それでもわからなければ、下記コードで個人情報に当たらない範囲でなるべく修正せずにこちらに投稿してください。
Sub SheetlayoutToClipBord()
'=====================================================
' 投稿用シートレイアウトをクリップボードに取得
' 作成者（ｍｏｍｏ）
'
' BrkStr：列間の文字列 初期値は「|」
' DataObjectID：DataObjectのLate Binding用（変更不可）
' https://www.excel.studio-kazu.jp/kw/20110209184943.html
'=====================================================
Const BrkStr As String = "|"
Const DataObjectID As String = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
Dim myRng As Range
Dim rngFormula As Range
Dim rngBuf As Range
Dim tbl() As Variant
Dim AryTxt() As String
Dim StrBuf As String
Dim i As Long
Dim j As Long
Dim cnt As Long
Dim AryWidth() As Long
Dim LenBuf As Long
cnt = 1
On Error Resume Next
Set myRng = Application.InputBox("取得したい範囲を選択してください。", Type:=8, Default:=Selection.Address)
On Error GoTo 0
If myRng Is Nothing Then
'何も選択されなかったら、何もしない。
Else
'If MsgBox("数式として表示したい範囲はありますか？", vbYesNo) = vbYes Then
Do
On Error Resume Next
Set rngBuf = Application.InputBox("数式として表示したい範囲を選択してください。" & cnt & "個目", Type:=8)
On Error GoTo 0
If Not rngBuf Is Nothing Then
If rngFormula Is Nothing Then
Set rngFormula = rngBuf
Else
Set rngFormula = Application.Union(rngFormula, rngBuf)
End If
cnt = cnt + 1
Else
Exit Do
End If
Set rngBuf = Nothing
Loop 'While MsgBox("さらに数式として表示したい範囲がありますか？", vbYesNo) = vbYes
'End If
ReDim tbl(1 To myRng.Rows.Count, 1 To myRng.Columns.Count)
ReDim AryWidth(1 To UBound(tbl, 2))
For i = 1 To myRng.Rows.Count
For j = 1 To myRng.Columns.Count
tbl(i, j) = myRng.Cells(i, j).Text
If Not rngFormula Is Nothing Then
If Not Application.Intersect(myRng.Cells(i, j), rngFormula) Is Nothing Then
tbl(i, j) = myRng.Cells(i, j).Formula
End If
End If
LenBuf = Application.Evaluate("LENB(""" & Replace(tbl(i, j), """", vbTab) & """)")
If AryWidth(j) < LenBuf Then
AryWidth(j) = LenBuf
End If
Next j
Next i
ReDim AryTxt(UBound(tbl, 1))
AryTxt(0) = String(Len(myRng.Rows(myRng.Rows.Count).Row) + 3, " ")
For i = 1 To UBound(tbl, 2)
StrBuf = "[" & Split(myRng.Columns(i).EntireColumn.Address(False, False), ":")(0) & "]"
If AryWidth(i) > Len(StrBuf) Then
AryTxt(0) = AryTxt(0) & BrkStr & StrBuf & String(AryWidth(i) - Len(StrBuf), " ")
Else
AryTxt(0) = AryTxt(0) & BrkStr & StrBuf
AryWidth(i) = Len(StrBuf)
End If
Next i
For i = 1 To UBound(tbl, 1)
AryTxt(i) = " [" & myRng.Rows(i).Row & "]" & _
String(Len(myRng.Rows(myRng.Rows.Count).Row) - Len(myRng.Rows(i).Row), " ")
For j = 1 To UBound(tbl, 2)
LenBuf = Application.Evaluate("LENB(""" & Replace(tbl(i, j), """", vbTab) & """)")
If IsNumeric(tbl(i, j)) Then
AryTxt(i) = AryTxt(i) & BrkStr & String(AryWidth(j) - LenBuf, " ") & tbl(i, j)
Else
AryTxt(i) = AryTxt(i) & BrkStr & tbl(i, j) & String(AryWidth(j) - LenBuf, " ")
End If
Next j
Next i
With GetObject("new:" & DataObjectID)
.SetText Join(AryTxt, vbCrLf)
.PutInClipboard
End With
MsgBox "クリップボードにコピーしました。"
End If
End Sub
（稲葉） 2019/03/18(月) 16:50
ありがとうございます。
ステップインしても何も起きず・・・ちょっと分からないのですが、
他の簡易的なマクロを実行すると動くので、もう少し試行錯誤してみます。
丁寧にお教えいただき、ありがとうございました。
（ひなた） 2019/03/19(火) 09:07
何も起きず・・・じゃなくて、イミディエイトウィンドウで値確かめたりしました？
例えば
＞m = Val(ws.Range("B13").Value) * 4 + 5 '1月×4行＋5行
が終わった後イミディエイトウィンドウに
?m
と打って、エンター押したときに、希望の数値が出てましたか？
＞ For c = 3 To ws.Cells(14, Columns.Count).End(xlToLeft).Column Step 2 ＞ With Sheets(CStr(ws.Cells(14, c).Value)) ＞ .Cells(m, "F").Value = ws.Cells(15, c).Value この部分に関しても、 ?ws.Cells(15, c).Address とイミディエイトウィンドウに打ち込んで、希望のセル範囲になっているか確認しました？
（稲葉） 2019/03/19(火) 09:38
ありがとうございます。
お手数をおかけして申し訳ないです。イミディエイトウィンドウ初めて知りました・・・。
ちなみに手直ししたものが下記です。
Sub Copy()
Dim ws As Worksheet
Dim m As Long
Dim c As Long
Set ws = Sheets("E-Pay")
m = Month(ws.Range("D1").Value) * 4 + 5 '1月×4行＋5行、1月は9行目から
For c = 5 To ws.Cells(4, Columns.Count).End(xlToLeft).Column Step 2 '社員番号の始まり5列目、4行目の最終列から左方向の入力済み終端セルを取得、1列飛ばし
With Sheets(CStr(ws.Cells(4, c).Value)) → インデックスが有効範囲にありませんエラー '値を文字型に変更、4行目の社員番号の値
.Cells(m, "F").Value = ws.Cells(15, c).Value
.Cells(m, "J").Value = ws.Cells(23, c).Value
End With
Next c
End Sub
イミディエイトウィンドウの結果は
?m では 9が返ってきているのでこちらは大丈夫そうです。
すみません、With〜の行がいまいち理解できていないようです、値を変えたらエラーになってしまいました。
（ひなた） 2019/03/19(火) 10:40
ちなみに、参考までに・・・
コピー元 Sheet名：E-Pay
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N]
[1] |支給年月日： | | |2019年1月25日 | | | | | | | | | |
[2] |支給年月 | | |2019年1月 | |2019年1月 | |2019年1月 | |2019年1月 | |2019年1月 | |合計
[3] |所属 | | |所属 | 部 |所属 | 部 |所属 | 部 |所属 | 部 |所属 | 部|
[4] |社員番号 | | |社員番号 | 2| | 7| | 3| | 8| | 5|
[5] |氏名 | | |氏名 |A |氏名 |N |氏名 |K |氏名 |Y |氏名 |S |
[15]| | |A.小計 |課税分小計 |345,800|課税分小計 |174,500|課税分小計 |252,000|課税分小計 |153,000|課税分小計 | 0|925,300 [16]| |非課税分 |通勤手当 |通勤手当 | 4,000|通勤手当 | 20,000|通勤手当 | 16,000|通勤手当 | 4,000|通勤手当 | | 44,000 [17]| | | | | | | | | | | | | | [18]| | |B.小計 |非課税分小計 | 4,000|非課税分小計 | 20,000|非課税分小計 | 16,000|非課税分小計 | 4,000|非課税分小計 | 0| 44,000 [19]| |C.合計A+B| |支給額合計 |349,800|支給額合計 |194,500|支給額合計 |268,000|支給額合計 |157,000|支給額合計 | 0|969,300
[24]|差引控除後の金額| | |差引控除後の金額 |294,142|差引控除後の金額 |147,126|差引控除後の金額 |214,536|差引控除後の金額 |129,969|差引控除後の金額 | 0|785,773 [25]|控除額 |所得税 | |所得税 | 6,520|所得税 | 1,300|所得税 | 5,270|所得税 | 2,260|所得税 | | 15,350
[29]| |F.小計 | |控除額小計 | -409|控除額小計 | 3,943|控除額小計 | 10,300|控除額小計 | -1,862|控除額小計 | 0| 11,972 [30]|差引支給額C-D-F | | |差引支給額 |298,551|差引支給額 |163,183|差引支給額 |220,236|差引支給額 |135,831|差引支給額 | 0|817,801
コピー先
Sheet名：3
|[D] |[E]|[F] |[G]|[H]|[I]|[J] |[K]|[L]|[M] |[N]|[O]|[P] |[Q] |[R]|[S]
[5] |支給
月日| |総支給金額| | | |社会保険
料等の
控除額| | |社会保険料等
控除後の給与
等の金額| | |扶養親族等の数|算出税額| |
[6] | | | | | | | | | | | | | | | |
[7] | | | | | | | | | | | | | | | |
[8] | | | | | | | | | | | | | | | |
[9] | 1| 25| 252,000 | | |円 | 37,464 | |円 | 214,536 | |円 | 0| 5,270 | |円
[10]| | | | | | | | | | | | | | | |
[11]| | | | | | | | | | | | | | | |
[12]| | | | | | | | | | | | | | | |
[13]| 2| | | | | | | | | | | | 0| | |
[14]| | | | | | | | | | | | | | | |
[15]| | | | | | | | | | | | | | | |
[16]| | | | | | | | | | | | | | | |
[17]| 3| | | | | | | | | | | | 0| | |
[18]| | | | | | | | | | | | | | | |
[19]| | | | | | | | | | | | | | | |
[20]| | | | | | | | | | | | | | | |
[21]| 4| | | | | | | | | | | | 0| | |
[22]| | | | | | | | | | | | | | | |
[23]| | | | | | | | | | | | | | | |
[24]| | | | | | | | | | | | | | | |
[25]| 5| | | | | | | | | | | | 0| | |
[26]| | | | | | | | | | | | | | | |
[27]| | | | | | | | | | | | | | | |
[28]| | | | | | | | | | | | | | | |
[29]| 6| | | | | | | | | | | | 0| | |
[30]| | | | | | | | | | | | | | | |
[31]| | | | | | | | | | | | | | | |
[32]| | | | | | | | | | | | | | | |
[33]| 7| | | | | | | | | | | | 0| | |
[34]| | | | | | | | | | | | | | | |
[35]| | | | | | | | | | | | | | | |
[36]| | | | | | | | | | | | | | | |
[37]| 8| | | | | | | | | | | | 0| | |
[38]| | | | | | | | | | | | | | | |
[39]| | | | | | | | | | | | | | | |
[40]| | | | | | | | | | | | | | | |
[41]| 9| | | | | | | | | | | | 0| | |
[42]| | | | | | | | | | | | | | | |
[43]| | | | | | | | | | | | | | | |
[44]| | | | | | | | | | | | | | | |
[45]| 10| | | | | | | | | | | | 0| | |
[46]| | | | | | | | | | | | | | | |
[47]| | | | | | | | | | | | | | | |
[48]| | | | | | | | | | | | | | | |
[49]| 11| | | | | | | | | | | | 0| | |
[50]| | | | | | | | | | | | | | | |
[51]| | | | | | | | | | | | | | | |
[52]| | | | | | | | | | | | | | | |
[53]| 12| | | | | | | | | | | | 0| | |
[54]| | | | | | | | | | | | | | | |
[55]| | | | | | | | | | | | | | | |
[56]| | | | | | | | | | | | | | | |
この下に合計額が入ります。
（ひなた） 2019/03/19(火) 10:57
＞With Sheets(CStr(ws.Cells(4, c).Value)) → インデックスが有効範囲にありませんエラー '値を文字型に変更、4行目の社員番号の値 インデックスエラーになるなら、それはシート名が存在しないってことです。 セルの値が誤っている（空白があるとか）かシート名が誤っているので １） debug.print "[" & CStr(ws.Cells(4, c).Value) & "]" をWithの前に入れて、値を教えてください。
２）
Sub シート名取得()
Dim ws As Worksheet
For Each ws In Sheets
Debug.Print ws.Name
Next ws
End Sub
このコードを実行して、シート名一覧をこちらに出してもらえますか？
あと ＞?ws.Cells(15, c).Address ＞とイミディエイトウィンドウに打ち込んで、希望のセル範囲になっているか確認しました？ こちらはどうなりましたか？
（稲葉） 2019/03/19(火) 11:56
お世話になっております。
すみません、4行目だと私が思っているところ、もう一度教えて欲しいのですが
Cells(4,c)
この部分、4はシートですか？
１）
debug.print "[" & CStr(ws.Cells(4, c).Value) & "]"With Sheets(CStr(ws.Cells(4, c).Value))
ということでしょうか？構文エラーになってしまったのですが
２）
COO
COO2
E-Pay
P-Pay
E-bonus
P-bonus
Pay-bill
Bonus-bill
1
2
3
7
8
5
徴収簿裏面
一覧
?1
?2
?3
?5
?7
?8
３）インデックスが有効範囲にありませんとエラーが出ますので、ステップインでも進むことができず、確認できませんでした。
（ひなた） 2019/03/19(火) 13:00
またまた横からですけど、「（ひなた） 2019/03/19(火) 10:57」に提示されたレイアウトを拝見すると
●月を調べるには・・・E-Payシートの「D1」セルに【日付型】のデータがあるのでそこから【何月】か調べればよい
ということになりますね。
一方で、新しい情報として
●E-Payシートの４行目に社員番号があるが、必ずしも若い順に並んでる訳でない
というように読めますが、合ってますか？
また、転記の対象としたいのは、E-Payシートの
15行目にあたる【課税分小計】と 23行目（例示されていない）
の二つという理解でよいのでしょうか？
さらに、出力先のシート（セル）は、
"F9:H10","F13:H14","F17:H18","F21:H22"... "J9:K10","J13:K14","J17:K18","J17:K18"...
のように、間に2行入る感じ（4行分ずれ）でそれぞれの塊が結合されているという理解で良いですか？
仮に、上のとおりならばですが、一例で
(1)E-Payシートの「D1」から【何月】であるかを取得する
(2)E-Payシートの4行目のうち【何列目】に対象の社員番号があるか調べる → 無い場合はユーザーに通知のうえ次の社員番号へ移行 (3)ブック内に対象の社員番号シートがあるか調べる → 無い場合はエラーメッセージを表示して終了
(4)E-Payシートの15行目、【何列目】の値を覚えておく (5)E-Payシートの23行目、【何列目】の値を覚えておく
(6)社員番号シートの（5 + (4 * 【何月】))行目、F列のセルに(4)で覚えた値をコピペ転記する (7)社員番号シートの（5 + (4 * 【何月】))行目、J列のセルに(5)で覚えた値を転記する
(8)(2)〜(7)を社員番号1〜9まで繰り返す
という処理を考えてみてはどうでしょうか？
P.S.
「（もこな２） 2019/03/18(月) 13:14」を読み直してみたら敬称が抜けてました。
稲葉さんごめんなさい。
（もこな２） 2019/03/19(火) 13:10
誤 〜コピペ転記〜 正 〜コピペではなく値を転記〜
そして、「（もこな２） 2019/03/19(火) 13:10」の案をコード化するとこんな感じになるとおもいます。
Sub さんぷる()
Dim 何月 As Long
Dim 何列目 As Variant
Dim 社員番号 As Long
Dim dstSH As Worksheet
Dim 覚えておく値1, 覚えておく値2
Stop '←ブレークポイントのかわり
With Worksheets("E-Pay")
何月 = Month(.Range("D1").Value)
For 社員番号 = 1 To 9
If 社員番号 = 4 Then 社員番号 = 社員番号 + 1 '★良い手が思いつかないのでとりあえず
何列目 = Application.Match(社員番号, .Rows(4), 0)
If IsError(何列目) Then
MsgBox "社員番号 " & 社員番号 & " が見つかりません" & vbCrLf & "次の社員番号に移行します"
Else
On Error Resume Next
Set dstSH = Worksheets(CStr(社員番号))
On Error GoTo 0
If dstSH Is Nothing Then
MsgBox CStr(社員番号) & "シートがありません" & vbCrLf & "処理を中止します"
Exit Sub
End If
覚えておく値1 = .Cells(15, 何列目).Value
覚えておく値2 = .Cells(23, 何列目).Value
dstSH.Cells((5 + (4 * 何月)), "F").Value = 覚えておく値1
dstSH.Cells((5 + (4 * 何月)), "J").Value = 覚えておく値2
Set dstSH = Nothing
End If
Next 社員番号
End With
End Sub
（もこな２） 2019/03/19(火) 15:58
ありがとうございます。
まず、質問にお答えしますと
●月を調べるには・・・E-Payシートの「D1」セルに【日付型】のデータがあるのでそこから【何月】か調べればよい→その通りです。
●E-Payシートの４行目に社員番号があるが、必ずしも若い順に並んでる訳でない
→そうですね、入社順ですが、そこら辺は私の判断で順番にできないことはないです。ただ4番は欠番です。
また、転記の対象としたいのは、E-Payシートの
15行目にあたる【課税分小計】と 23行目（例示されていない） の二つという理解でよいのでしょうか？ →[15]課税分小計 [23]社会保険料控除額（誤って削除してしまいました） [24]差引控除後の金額 [25]所得税 です。 出力先のシート（セル）は、 "F9:H10","F13:H14","F17:H18","F21:H22"... "J9:K10","J13:K14","J17:K18","J21:K22"... "M9:N10","M13:N14","M17:N18","M21:N22"... "Q9:R10","Q13:R14","Q17:R18","Q21:R22"... となります。 （ひなた） 2019/03/19(火) 16:47
１）は debug.print "[" & CStr(ws.Cells(4, c).Value) & "]" ’←E-Payシートの4行目変数c列の値を調べる With Sheets(CStr(ws.Cells(4, c).Value)) このようにしてほしかったです。 そうすれば、前後にスペースがあるとかないとかわかるので・・・
２）は私のコードが失敗でした。
こっちで再度お願いします。
Sub シート名取得()
Dim ws As Worksheet
For Each ws In Sheets
Debug.Print "[" & ws.Name & "]"
Next ws
End Sub
３）
提示してもらったデータでこちらは問題なくコピーできましたので、シート名が異なっている可能性が高いです。
シートの有無をチェックするコードを追加したので、再度実行してみてください。
Sub Copy2()
Dim ws As Worksheet
Dim m As Long
Dim c As Long
Dim msg As String
Set ws = Sheets("E-Pay")
m = Month(ws.Range("D1").Value) * 4 + 5 '1月×4行＋5行、1月は9行目から
For c = 5 To ws.Cells(4, Columns.Count).End(xlToLeft).Column Step 2 '社員番号の始まり5列目、4行目の最終列から左方向の入力済み終端セルを取得、1列飛ばし
If Evaluate("=ISREF(" & CStr(ws.Cells(4, c).Value) & "!A1)") Then
With Sheets(CStr(ws.Cells(4, c).Value)) ' → インデックスが有効範囲にありませんエラー '値を文字型に変更、4行目の社員番号の値
.Cells(m, "F").Value = ws.Cells(15, c).Value
.Cells(m, "J").Value = ws.Cells(23, c).Value
End With
Else
msg = msg & vbCrLf & "社員番号：" & ws.Cells(4, c).Value
End If
Next c
If msg <> "" Then
MsgBox Mid$(msg, 2) & "のシートが見つかりませんでした"
End If
End Sub
（稲葉） 2019/03/19(火) 17:18
じつは、出力先のセル番地より、どのように結合されているのかが確認したかったことですが、聞き方がまずかったです。
とりあえず提示の部分がそっくり（2行3列の塊で）結合されているとした場合です。
Sub さんぷる()
Dim 何月 As Long
Dim 何列目 As Variant
Dim 社員番号 As Long
Dim dstSH As Worksheet
Stop '←ブレークポイントのかわり
With Worksheets("E-Pay")
何月 = Month(.Range("D1").Value)
For 社員番号 = 1 To 9
If 社員番号 = 4 Then 社員番号 = 社員番号 + 1 '★良い手が思いつかないのでとりあえず
何列目 = Application.Match(社員番号, .Rows(4), 0)
If IsError(何列目) Then
MsgBox "社員番号 " & 社員番号 & " が見つかりません" & vbCrLf & "次の社員番号に移行します"
Else
On Error Resume Next
Set dstSH = Worksheets(CStr(社員番号))
On Error GoTo 0
If dstSH Is Nothing Then
MsgBox CStr(社員番号) & "シートがありません" & vbCrLf & "処理を中止します"
Exit Sub
End If
dstSH.Cells((5 + (4 * 何月)), "F").Value = .Cells(15, 何列目).Value
dstSH.Cells((5 + (4 * 何月)), "J").Value = .Cells(23, 何列目).Value
dstSH.Cells((5 + (4 * 何月)), "M").Value = .Cells(24, 何列目).Value
dstSH.Cells((5 + (4 * 何月)), "Q").Value = .Cells(25, 何列目).Value
Set dstSH = Nothing
End If
Next 社員番号
End With
End Sub
（もこな２） 2019/03/19(火) 19:01
稲葉さん
１）失礼しました。With〜を改行したら動作しました。びっくりぽんです。
２）
[COO]
[COO2]
[E-Pay]
[P-Pay]
[E-bonus]
[P-bonus]
[Pay-bill]
[Bonus-bill]
[1]
[2]
[3]
[7]
[8]
[5]
[徴収簿裏面]
[一覧]
[?1]
[?2]
[?3]
[?5]
[?7]
[?8]
３）できました！昨日まで何故できなかったのか謎です・・・
（ひなた） 2019/03/20(水) 08:46
ありがとうございます。
返信の順番前後して申し訳ありませんでした。
もこな2さんのコードサンプルでもバッチリできました！
InputBoxもMsgBoxも使ったことがなかったので、使い方も勉強になりました。
（ひなた） 2019/03/20(水) 08:50
できたようで良かったです 解決でよろしいですかね？ （稲葉） 2019/03/20(水) 09:00
はい、あとは貼付け先の欄を自分で増やして解決できましたので。
長い間お付き合いいただきありがとうございました。
丁寧に教えていただき、大変勉強になりました。
（ひなた） 2019/03/20(水) 12:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.