Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2498 / 13645 ツリー ←次へ | 前へ→

【67583】様式の異なるシート間での値の抽出と転記について 八家九僧陀 10/12/16(木) 12:48 質問[未読]
【67588】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/16(木) 21:58 回答[未読]
【67589】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/16(木) 22:21 発言[未読]
【67591】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/17(金) 2:10 お礼[未読]
【67599】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/17(金) 10:44 回答[未読]
【67600】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/17(金) 11:33 回答[未読]
【67622】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/18(土) 23:48 発言[未読]
【67624】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/19(日) 7:44 発言[未読]
【67625】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/19(日) 8:33 発言[未読]
【67628】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/19(日) 9:34 発言[未読]
【67629】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/19(日) 15:25 回答[未読]
【67632】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/20(月) 0:09 お礼[未読]
【67633】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/20(月) 6:46 発言[未読]
【67647】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/20(月) 22:54 発言[未読]
【67660】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/21(火) 18:22 発言[未読]
【67670】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/22(水) 17:44 発言[未読]
【67671】Re:様式の異なるシート間での値の抽出と転... UO3 10/12/22(水) 18:14 発言[未読]
【67674】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/23(木) 21:53 お礼[未読]
【67603】Re:様式の異なるシート間での値の抽出と転... こたつねこ 10/12/17(金) 12:30 回答[未読]
【67623】Re:様式の異なるシート間での値の抽出と転... 八家九僧陀 10/12/18(土) 23:52 発言[未読]

【67583】様式の異なるシート間での値の抽出と転記...
質問  八家九僧陀  - 10/12/16(木) 12:48 -

引用なし
パスワード
   前回「Dictionaryについて」で質問した年末調整処理作業に関係した質問をさせていただきます。
前回質問をして年間給与額、社会保険料控除額、源泉徴収税額の集計ができました。その集計結果に基づきUserForm上で年税額や12月分給与支給時の還付額、不足額等を計算した結果を"年調DATA"シートに転記できるようにしています。
その「年調DATA」シートから、逆に12月分給与支給データのあるシート"最終支給台帳"に還付額、不足額を転記して、(12月分の)控除額合計と(12月分の)差引給与支給額を再計算させたいのですが、以下について教えてください。

使用環境 excel97です。

●sheets("年調DATA")の表形式は、A列が見出項目で、B列以降(列単位で)に個人単位で本人、配偶者、扶養家族等の各DATAを収納しています。列数は可変、行数は149行の表ですぅ。
1行目に[社員ID]、2行目に[氏名],13行目[年末調整するしない]、53行目に[還付額](12月分給与支給時に還付する場合)、54行目に[不足額](12月給与支給時に追加徴収する額)の各データを収納しています。

●sheets("最終支給台帳")の表形式は、1行目は見出しでA列〜CR列までで、A列に[社員ID]、B列に[氏名]、以下行単位に個人単位のデータを収納しています。

●仮称「確定転記」ボタンを押したときに、sheets("年調DATA")からsheets("最終支給台帳")に、社員IDをキーとして次の処理をさせたいのですが。

1.sheets("年調DATA")13行目[年末調整するしない]で、「年末調整する」のときは
次の処理をし、「年末調整しない」のときはsheets("最終支給台帳")に対して何もしない。

2.「年末調整する」のときの処理は、sheets("年調DATA")53行目[還付額]が、0<(以上)なら[0-53行目[還付額]]の値(負数)を、そうでないなら(53行目[還付額]が、0<でなく、54行目[不足額]が0<(以上)のとき)、54行目[不足額]の値(正数)を、sheets("最終支給台帳")のCO列の該当者セルに転記して、転記後に

3.CQ列[控除額合計] = BZ列[社保控除額] + CB列[定額控除] + CC列[変動控除] + CO列[源泉徴収税額] (転記した値)+ CP列[市民税]

4.CR列[差引支給額] = BL列[総支給額] ー CQ列[控除額合計]

以上の処理をしたいのですが、またまた丸投げで申し訳ありませんが、ご教示お願いします。
なにせ12月分給与が、20日締めの25日明細書渡し、月末支給と期限が迫り、同時にこの年末調整をする必要があり、切羽詰まっています。何卒お助けください。

小さな観光バス会社のバス運転手兼庶務担当をやらさせ、つい最近13日、14日も東京新名所ツアーなる奇妙な夜行に行かされ、止まってゆっくり見学できるわけではない建設中のスカイツリーや近くの浅草、そこからお台場、セントレアと似たような羽田空港新ターミナル、乗務員の仮眠施設は大江戸温泉内で仮眠と、かなりきつい行程を走らされた揚句、「もうじき給料と年末調整するから頼むね」と念押しされ、あせっています。お助けを!!!!

【67588】Re:様式の異なるシート間での値の抽出と...
回答  UO3  - 10/12/16(木) 21:58 -

引用なし
パスワード
   ▼八家九僧陀 さん:
>なにせ12月分給与が、20日締めの25日明細書渡し、月末支給と期限が迫り、同時にこの年末調整をする必要があり、切羽詰まっています。何卒お助けください。
おいそぎのようですので、大急ぎで書きました。
バグあるかも?
要否欄の文字列は、正しい者にかえてください。
とりあえず、"年末調整する" にしてあります。

(大江戸温泉、先週、私も浸かってきました)

Sub Sample()
 Const ID As Integer = 1
 Const YOUHI As Integer = 13
 Const KANPU As Integer = 53
 Const FUSOKU As Integer = 54
 Dim amt As Long
 Dim z As Long, x As Long
 Dim colA As Range
 Dim v As Variant
 Dim ck As Variant
 Dim idA As Range
 
 With Sheets("最終支給台帳")
  x = .Cells(.Rows.Count, 1).End(xlUp).Row
  Set idA = .Range("A2").Resize(x - 1)
  With .Range("CO2").Resize(x - 1)
   .ClearContents
   v = .Cells
  End With
 End With
 
 With Sheets("年調DATA")
  z = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For Each colA In .Range("B1").Resize(54, z - 1).Columns
   If colA.Cells(YOUHI).Value = "年末調整する" Then
    If colA.Cells(KANPU).Value > 0 Then
     amt = colA.Cells(KANPU).Value * -1
    Else
     amt = colA.Cells(FUSOKU).Value
    End If
'    MsgBox colA.Cells(ID).Value
'    MsgBox colA.Address
'    MsgBox idA.Address
    ck = Application.Match(colA.Cells(ID).Value, idA, 0)
    If IsNumeric(ck) Then
     v(ck, 1) = amt
    End If
   End If
  Next
  
  Sheets("最終支給台帳").Range("CO2").Resize(x - 1) = v
  
 End With
 
 Set idA = Nothing
 
End Sub

【67589】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/16(木) 22:21 -

引用なし
パスワード
   ↑ コメントアウトしたmsgbox 3行は、簡単なテスト中の確認コードです。
  削除しておいてください。

【67591】Re:様式の異なるシート間での値の抽出と...
お礼  八家九僧陀  - 10/12/17(金) 2:10 -

引用なし
パスワード
   ▼UO3 さん:
早速のご回答、本当にありがとうございます。
Sheets("年調DATA")には、まだ4列(4人分)しかデータをいれていませんが、
早速試してみました。
4名のうち、"年末調整する"者が3名、しない者が1名です。
msgboxもそのままに活用して確認したところ、
MsgBox colA.Cells(ID).Valueでは、3名のIDが表示されました。
MsgBox colA.Addressでは、その3名のデータが入っている列が表示されました。(例: E1:E54、B1:B54,C1:C54)
MsgBox idA.Addressでは、3名ともA2:A60とAddressが表示されました。

ところがSheets("最終支給台帳")側ではその3名の該当行になにも変化がありませんでした。(転記して、同時に再計算されていない???)
またidA.AddressのA2:A60が何故必要なのか、いまひとつわかりません。
ご教示いただいたコードをヒントに自分でしてみますといえるほどの知識もありませんので、引きつづきご教示をお願いします。

何とか次の処理をしたいのですが、よろしくお願いします。
1.「年末調整する」のときの処理は、sheets("年調DATA")53行目[還付額]が、0<(以上)なら[0-53行目[還付額]]の値(負数)を、そうでないなら(53行目[還付額]が、0<でなく、54行目[不足額]が0<(以上)のとき)、54行目[不足額]の値(正数)を、

2.sheets("最終支給台帳")のCO列の該当者セルに転記して、
3.転記後に CQ列[控除額合計] = BZ列[社保控除額] + CB列[定額控除] + CC列[変動控除] + CO列[源泉徴収税額] (転記した値)+ CP列[市民税]

4.CR列[差引支給額] = BL列[総支給額] ー CQ列[控除額合計]

【67599】Re:様式の異なるシート間での値の抽出と...
回答  UO3  - 10/12/17(金) 10:44 -

引用なし
パスワード
   ▼八家九僧陀 さん:

>ところがSheets("最終支給台帳")側ではその3名の該当行になにも変化がありませんでした。(転記して、同時に再計算されていない???)

そうでしたね!CO列に転記しただけでアップしちゃいました。
肝心の計算と、その結果転記、コードを追加します。しばしお待ちください。
(CO列には転記されましたよね?)

>またidA.AddressのA2:A60が何故必要なのか、いまひとつわかりません。

年調DATAのIDを転記先シート(最終支給台帳)のA列とマッチングさせる、その
A列の領域で、Application.Match で使っています。

【67600】Re:様式の異なるシート間での値の抽出と...
回答  UO3  - 10/12/17(金) 11:33 -

引用なし
パスワード
   ▼八家九僧陀 さん:

とりあえず、なんらかの計算結果が転記されます。
もしかしたら計算式間違っているかもしれませんが。
とにかく、試してみてください。

Option Explicit

Sub Sample2()
'========================================
'年調DATAシートの行規定
 Const ID As Integer = 1
 Const YOUHI As Integer = 13
 Const KANPU As Integer = 53
 Const FUSOKU As Integer = 54
'========================================
'最終支給台帳シートの列規定
 Const SOUSHIKYU As Integer = 64 'BL
 Const SHAHO As Integer = 78 'BZ
 Const TEIGAKU As Integer = 80 'CB
 Const HENDOU As Integer = 81 'CC
 Const CHOSYU As Integer = 93 'CO
 Const SIMIN As Integer = 94 'CP
 Const KOUJYO As Integer = 95 'CQ
 Const SASHIHIKI As Integer = 96 'CR
 Const ColMax As Integer = 96
'========================================
 Dim amt As Long
 Dim z As Long, x As Long
 Dim colA As Range
 Dim v As Variant
 Dim ck As Variant
 Dim idA As Range

 With Sheets("最終支給台帳")
  x = .Cells(.Rows.Count, 1).End(xlUp).Row
  Set idA = .Range("A2").Resize(x - 1)
  .Cells(2, CHOSYU).Resize(x - 1).ClearContents
  .Cells(2, KOUJYO).Resize(x - 1).ClearContents
  .Cells(2, SASHIHIKI).Resize(x - 1).ClearContents
  v = Cells(2, 1).Resize(x - 1, ColMax)
 End With

 With Sheets("年調DATA")
  z = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For Each colA In .Range("B1").Resize(54, z - 1).Columns
   If colA.Cells(YOUHI).Value = "年末調整する" Then
    If colA.Cells(KANPU).Value > 0 Then
     amt = colA.Cells(KANPU).Value * -1
    Else
     amt = colA.Cells(FUSOKU).Value
    End If
    ck = Application.Match(colA.Cells(ID).Value, idA, 0)
    If IsNumeric(ck) Then
     v(ck, CHOSYU) = amt
     v(ck, KOUJYO) = _
      v(ck, SHAHO) + v(ck, TEIGAKU) + v(ck, HENDOU) + v(ck, CHOSYU) + v(ck, SIMIN)
     v(ck, SASHIHIKI) = v(ck, SOUSHIKYU) - v(ck, KOUJYO)
    End If
   End If
  Next
 End With
 
 Sheets("最終支給台帳").Range("A2").Resize(x - 1, ColMax) = v
 
 Set idA = Nothing
 
 MsgBox "処理が完了しました"

End Sub

【67603】Re:様式の異なるシート間での値の抽出と...
回答  こたつねこ  - 10/12/17(金) 12:30 -

引用なし
パスワード
   八家九僧陀 さん
はじめまして、こたつねこと申します。
すでにUO3 さんから回答がありますが、作ってみたのでUPします。
Dictionaryを使った例・・・動作検証はしていませんのバグがある可能性があります。

Public Sub Sample()
  Const C_SHT_DATA As String = "年調DATA"
  Const C_SHT_POST As String = "最終支給台帳"
  Const C_MSG_COMPLETE As String = "処理完了"
  
  Dim EntryDic  As Object
  Dim Msg     As String
  Dim Ret     As Boolean
  
  Set EntryDic = CreateObject("Scripting.Dictionary")
  
  Ret = AcquisitionData(C_SHT_DATA, EntryDic, Msg)
  If (Ret) Then Ret = PostData(C_SHT_POST, EntryDic, Msg)
  
  If (Ret) Then
    MsgBox "処理完了", vbOKOnly
  Else
    MsgBox Msg, vbCritical
  End If
  
  Set EntryDic = Nothing
  
End Sub

'転記する処理
Private Function PostData( _
          ByVal SheetName As String _
         , ByRef Dic As Object _
         , ByRef Msg As String) As Boolean
  On Error GoTo Err_Function
  Const C_COL_ID     As String = "A"
  Const C_COL_TAX     As String = "CO"
  Const C_COL_SOCIAL   As String = "BZ"
  Const C_COL_DEDUCTION_C As String = "CB"
  Const C_COL_DEDUCTION_F As String = "CC"
  Const C_COL_INSURANCE  As String = "CQ"
  Const C_COL_CITIZENS  As String = "CP"
  Const C_COL_SUPPLIED_B As String = "CR"
  Const C_COL_SUPPLIED_T As String = "BL"
  Const C_ROW_START    As Long = 2
  Const C_ERR_MSG     As String = "該当するデータがありませんでした。"
  
  Dim Ret     As Boolean
  Dim Sht     As Excel.Worksheet
  Dim Row     As Long
  Dim IdNumber  As String
  Dim Social   As Currency
  Dim Deduction_C As Currency
  Dim Deduction_F As Currency
  Dim Tax     As Currency
  Dim Citizens  As Currency
  Dim Supplied_T As Currency
  Dim Supplied_B As Currency
  Dim Insurance  As Currency
  Dim HitCNT   As Long
  
  Set Sht = ThisWorkbook.Sheets(SheetName)
  HitCNT = 0
  
  For Row = C_ROW_START To Sht.Cells(Sht.Rows.Count, 1).End(xlUp).Row
    IdNumber = Sht.Range(C_COL_ID & Row).Value
    If (Dic.Exists(IdNumber)) Then
      HitCNT = HitCNT + 1
      Social = Sht.Range(C_COL_SOCIAL & Row).Value
      Deduction_C = Sht.Range(C_COL_DEDUCTION_C & Row).Value
      Deduction_F = Sht.Range(C_COL_DEDUCTION_F & Row).Value
      Citizens = Sht.Range(C_COL_CITIZENS & Row).Value
      Supplied_T = Sht.Range(C_COL_SUPPLIED_T & Row).Value
      Tax = Dic(IdNumber)
      
      Insurance = Social + Deduction_C + Deduction_F + Tax + Citizens
      Supplied_B = Supplied_T - Insurance
      
      Sht.Range(C_COL_TAX & Row).Value = Tax
      Sht.Range(C_COL_INSURANCE & Row).Value = Insurance
      Sht.Range(C_COL_SUPPLIED_B & Row).Value = Supplied_B
    End If
  Next Row
  
  If HitCNT = 0 Then
    Msg = C_ERR_MSG
    Ret = False
  Else
    Ret = True
  End If
Exit_Function:
  If Not (Sht Is Nothing) Then Set Sht = Nothing
  PostData = Ret
  Exit Function
Err_Function:
  Ret = False
  Msg = Err.Description
  Err.Clear
  Resume Exit_Function
End Function

'転記対象データを取得する処理
Private Function AcquisitionData(ByVal SheetName As String, ByRef RetDic As Object, ByRef Msg As String) As Boolean
  On Error GoTo Err_Function
  Const C_ROW_ID   As Long = 1
  Const C_ROW_FLG   As Long = 13
  Const C_ROW_MONEY1 As Long = 53
  Const C_ROW_MONEY2 As Long = 54
  Const C_HIT_STR   As String = "する"
  Const C_ERR_MSG   As String = "年調DATAからデータを取得できませんでした。"
  
  Dim Ret As Boolean
  Dim Sht As Excel.Worksheet
  Dim Row As Long
  Dim Col As Long
  Dim IdNumber  As String
  Dim Restoration As Currency
  Dim Lack    As Currency
  
  Set Sht = ThisWorkbook.Sheets(SheetName)
  
  For Col = 2 To Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column

    If (Sht.Cells(C_ROW_FLG, Col).Value = C_HIT_STR) Then
      IdNumber = Sht.Cells(C_ROW_ID, Col).Value
      Restoration = Sht.Cells(C_ROW_MONEY1, Col).Value
      Lack = Sht.Cells(C_ROW_MONEY2, Col).Value
      If (0 < Restoration) Then
        RetDic(IdNumber) = 0 - Restoration
      Else
        RetDic(IdNumber) = Lack
      End If
    End If
  Next Col
  
  If (RetDic.Count = 0) Then
    Msg = C_ERR_MSG
    Ret = False
  Else
    Ret = True
  End If
Exit_Function:
  If Not (Sht Is Nothing) Then Set Sht = Nothing
  AcquisitionData = Ret
  Exit Function
Err_Function:
  Ret = False
  Msg = Err.Description
  Err.Clear
  Resume Exit_Function
End Function

【67622】Re:様式の異なるシート間での値の抽出と...
発言  八家九僧陀  - 10/12/18(土) 23:48 -

引用なし
パスワード
   ▼UO3 さん:
ほうとうにお世話になります。
自宅のパソコンはネットに繋がっていないため、会社のパソコンでこのサイトからコピペして実行してみましたが、”とりあえず、なんらかの計算結果が転記され”ずに、逆に[CHOSYU]、[KOUJYO]、[SASHIHIKI]の各列のデータが消失してしまいました。

そのままコピペしたので、スペルや誤記は全くないのですが????
お世話をかけますが、改良策はないでしょうか?


>▼八家九僧陀 さん:
>
>とりあえず、なんらかの計算結果が転記されます。
>もしかしたら計算式間違っているかもしれませんが。
>とにかく、試してみてください。
>
>Option Explicit
>
>Sub Sample2()
>'========================================
>'年調DATAシートの行規定
> Const ID As Integer = 1
> Const YOUHI As Integer = 13
> Const KANPU As Integer = 53
> Const FUSOKU As Integer = 54
>'========================================
>'最終支給台帳シートの列規定
> Const SOUSHIKYU As Integer = 64 'BL
> Const SHAHO As Integer = 78 'BZ
> Const TEIGAKU As Integer = 80 'CB
> Const HENDOU As Integer = 81 'CC
> Const CHOSYU As Integer = 93 'CO
> Const SIMIN As Integer = 94 'CP
> Const KOUJYO As Integer = 95 'CQ
> Const SASHIHIKI As Integer = 96 'CR
> Const ColMax As Integer = 96
>'========================================
> Dim amt As Long
> Dim z As Long, x As Long
> Dim colA As Range
> Dim v As Variant
> Dim ck As Variant
> Dim idA As Range
>
> With Sheets("最終支給台帳")
>  x = .Cells(.Rows.Count, 1).End(xlUp).Row
>  Set idA = .Range("A2").Resize(x - 1)
>  .Cells(2, CHOSYU).Resize(x - 1).ClearContents
>  .Cells(2, KOUJYO).Resize(x - 1).ClearContents
>  .Cells(2, SASHIHIKI).Resize(x - 1).ClearContents
>  v = Cells(2, 1).Resize(x - 1, ColMax)
> End With
>
> With Sheets("年調DATA")
>  z = .Cells(1, .Columns.Count).End(xlToLeft).Column
>  For Each colA In .Range("B1").Resize(54, z - 1).Columns
>   If colA.Cells(YOUHI).Value = "年末調整する" Then
>    If colA.Cells(KANPU).Value > 0 Then
>     amt = colA.Cells(KANPU).Value * -1
>    Else
>     amt = colA.Cells(FUSOKU).Value
>    End If
>    ck = Application.Match(colA.Cells(ID).Value, idA, 0)
>    If IsNumeric(ck) Then
>     v(ck, CHOSYU) = amt
>     v(ck, KOUJYO) = _
>      v(ck, SHAHO) + v(ck, TEIGAKU) + v(ck, HENDOU) + v(ck, CHOSYU) + v(ck, SIMIN)
>     v(ck, SASHIHIKI) = v(ck, SOUSHIKYU) - v(ck, KOUJYO)
>    End If
>   End If
>  Next
> End With
> 
> Sheets("最終支給台帳").Range("A2").Resize(x - 1, ColMax) = v
> 
> Set idA = Nothing
> 
> MsgBox "処理が完了しました"
>
>End Sub

【67623】Re:様式の異なるシート間での値の抽出と...
発言  八家九僧陀  - 10/12/18(土) 23:52 -

引用なし
パスワード
   ▼こたつねこ さん:
お世話をお掛けして、ありがとうございます。
そっくりそのままコピペして実行してみたのですが、
Const C_ERR_MSG     As String = "該当するデータがありませんでした。"
の"該当するデータがありませんでした。"とすぐに表示され終了します。
わたしにとっては、とても難解なコードで、自力で改善する能力もありません。
引き続きご教示をお願いします。


>八家九僧陀 さん
>はじめまして、こたつねこと申します。
>すでにUO3 さんから回答がありますが、作ってみたのでUPします。
>Dictionaryを使った例・・・動作検証はしていませんのバグがある可能性があります。
>
>Public Sub Sample()
>  Const C_SHT_DATA As String = "年調DATA"
>  Const C_SHT_POST As String = "最終支給台帳"
>  Const C_MSG_COMPLETE As String = "処理完了"
>  
>  Dim EntryDic  As Object
>  Dim Msg     As String
>  Dim Ret     As Boolean
>  
>  Set EntryDic = CreateObject("Scripting.Dictionary")
>  
>  Ret = AcquisitionData(C_SHT_DATA, EntryDic, Msg)
>  If (Ret) Then Ret = PostData(C_SHT_POST, EntryDic, Msg)
>  
>  If (Ret) Then
>    MsgBox "処理完了", vbOKOnly
>  Else
>    MsgBox Msg, vbCritical
>  End If
>  
>  Set EntryDic = Nothing
>  
>End Sub
>
>'転記する処理
>Private Function PostData( _
>          ByVal SheetName As String _
>         , ByRef Dic As Object _
>         , ByRef Msg As String) As Boolean
>  On Error GoTo Err_Function
>  Const C_COL_ID     As String = "A"
>  Const C_COL_TAX     As String = "CO"
>  Const C_COL_SOCIAL   As String = "BZ"
>  Const C_COL_DEDUCTION_C As String = "CB"
>  Const C_COL_DEDUCTION_F As String = "CC"
>  Const C_COL_INSURANCE  As String = "CQ"
>  Const C_COL_CITIZENS  As String = "CP"
>  Const C_COL_SUPPLIED_B As String = "CR"
>  Const C_COL_SUPPLIED_T As String = "BL"
>  Const C_ROW_START    As Long = 2
>  Const C_ERR_MSG     As String = "該当するデータがありませんでした。"
>  
>  Dim Ret     As Boolean
>  Dim Sht     As Excel.Worksheet
>  Dim Row     As Long
>  Dim IdNumber  As String
>  Dim Social   As Currency
>  Dim Deduction_C As Currency
>  Dim Deduction_F As Currency
>  Dim Tax     As Currency
>  Dim Citizens  As Currency
>  Dim Supplied_T As Currency
>  Dim Supplied_B As Currency
>  Dim Insurance  As Currency
>  Dim HitCNT   As Long
>  
>  Set Sht = ThisWorkbook.Sheets(SheetName)
>  HitCNT = 0
>  
>  For Row = C_ROW_START To Sht.Cells(Sht.Rows.Count, 1).End(xlUp).Row
>    IdNumber = Sht.Range(C_COL_ID & Row).Value
>    If (Dic.Exists(IdNumber)) Then
>      HitCNT = HitCNT + 1
>      Social = Sht.Range(C_COL_SOCIAL & Row).Value
>      Deduction_C = Sht.Range(C_COL_DEDUCTION_C & Row).Value
>      Deduction_F = Sht.Range(C_COL_DEDUCTION_F & Row).Value
>      Citizens = Sht.Range(C_COL_CITIZENS & Row).Value
>      Supplied_T = Sht.Range(C_COL_SUPPLIED_T & Row).Value
>      Tax = Dic(IdNumber)
>      
>      Insurance = Social + Deduction_C + Deduction_F + Tax + Citizens
>      Supplied_B = Supplied_T - Insurance
>      
>      Sht.Range(C_COL_TAX & Row).Value = Tax
>      Sht.Range(C_COL_INSURANCE & Row).Value = Insurance
>      Sht.Range(C_COL_SUPPLIED_B & Row).Value = Supplied_B
>    End If
>  Next Row
>  
>  If HitCNT = 0 Then
>    Msg = C_ERR_MSG
>    Ret = False
>  Else
>    Ret = True
>  End If
>Exit_Function:
>  If Not (Sht Is Nothing) Then Set Sht = Nothing
>  PostData = Ret
>  Exit Function
>Err_Function:
>  Ret = False
>  Msg = Err.Description
>  Err.Clear
>  Resume Exit_Function
>End Function
>
>'転記対象データを取得する処理
>Private Function AcquisitionData(ByVal SheetName As String, ByRef RetDic As Object, ByRef Msg As String) As Boolean
>  On Error GoTo Err_Function
>  Const C_ROW_ID   As Long = 1
>  Const C_ROW_FLG   As Long = 13
>  Const C_ROW_MONEY1 As Long = 53
>  Const C_ROW_MONEY2 As Long = 54
>  Const C_HIT_STR   As String = "する"
>  Const C_ERR_MSG   As String = "年調DATAからデータを取得できませんでした。"
>  
>  Dim Ret As Boolean
>  Dim Sht As Excel.Worksheet
>  Dim Row As Long
>  Dim Col As Long
>  Dim IdNumber  As String
>  Dim Restoration As Currency
>  Dim Lack    As Currency
>  
>  Set Sht = ThisWorkbook.Sheets(SheetName)
>  
>  For Col = 2 To Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column
>
>    If (Sht.Cells(C_ROW_FLG, Col).Value = C_HIT_STR) Then
>      IdNumber = Sht.Cells(C_ROW_ID, Col).Value
>      Restoration = Sht.Cells(C_ROW_MONEY1, Col).Value
>      Lack = Sht.Cells(C_ROW_MONEY2, Col).Value
>      If (0 < Restoration) Then
>        RetDic(IdNumber) = 0 - Restoration
>      Else
>        RetDic(IdNumber) = Lack
>      End If
>    End If
>  Next Col
>  
>  If (RetDic.Count = 0) Then
>    Msg = C_ERR_MSG
>    Ret = False
>  Else
>    Ret = True
>  End If
>Exit_Function:
>  If Not (Sht Is Nothing) Then Set Sht = Nothing
>  AcquisitionData = Ret
>  Exit Function
>Err_Function:
>  Ret = False
>  Msg = Err.Description
>  Err.Clear
>  Resume Exit_Function
>End Function

【67624】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/19(日) 7:44 -

引用なし
パスワード
   ▼八家九僧陀 さん:

>”とりあえず、なんらかの計算結果が転記され”ずに、逆に[CHOSYU]、[KOUJYO]、[SASHIHIKI]の各列のデータが消失してしまいました。

・まず、各列は、計算させてセットる列ですので、処理前に、いったん列の値をクリアしています。(対象外の行については、これらの列の値は空白になります。)
 対象外以外の行については、その前に入っていた値を残したいということなら
 クリアしている部分を削除しますが、要件としては、どちらでしょう?
・こちらでは対象行の計算、転記が実行されていますので、されないということは、
 私が要件を誤解しているところがまだあるということでしょうね。
 調べててみます。
 ★CO列には何かセットされましたか? 

【67625】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/19(日) 8:33 -

引用なし
パスワード
   ▼八家九僧陀 さん:

まず、上でレスで1行、タイプミスがありました。

誤)対象外以外の行については、その前に入っていた値を残したいということなら
   ↓
正)対象行以外の行については、その前に入っていた値を残したいということなら

で、確認なんですが、年調DATAシートの13行目の要否欄、とりあえずコードでは
申し上げましたように、"年末調整する"という文字列をキーワードにしています。
対象の人の13行目に、この文字列を入れていただきましたか?

【67628】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/19(日) 9:34 -

引用なし
パスワード
   ▼八家九僧陀 さん:

13行目の要否指定の文字列については、ご確認をお願いします。
実際に記入しておられる文字列は Yes,No とか 要、不要 等かもしれませんね。
最終的には実際に使っている文字列にコードをあわせましょう。

★ところで、シートのイメージをよくよく思い返していましたら
 CO列は、対象者のみが値を持ち、それ以外の人は空白でいいと思いますが
 CQ列、CR列は、全部の人が対象だということに思い当たりました。
 方法は2つあります。いずれがよろしいですか?

 1)対象者のみを置き換え、そのほかの人達のところは【触らない】
 2)すべての人に対して【再計算させる】

【67629】Re:様式の異なるシート間での値の抽出と...
回答  UO3  - 10/12/19(日) 15:25 -

引用なし
パスワード
   ▼八家九僧陀 さん:

いくつかお聞きしていますが、おそらく、こういうことだろうというコードを。
(しつこいようですが、13行目の要否の文字列は実態にあわせる必要ありますが)

今回アップするコードでは宣言文内の行の規定はいいのですが、
列規定が、かえってコードを煩雑にしてしまいますので、削除し、列記号を
直接コーディングしています。

Sub Sample3()
'========================================
'年調DATAシートの行規定
 Const ID As Integer = 1
 Const YOUHI As Integer = 13
 Const KANPU As Integer = 53
 Const FUSOKU As Integer = 54
'========================================
 Dim amt As Long
 Dim z As Long, x As Long
 Dim colA As Range
 Dim v() As Variant
 Dim ck As Variant
 Dim idA As Range

 With Sheets("最終支給台帳")
  x = .Cells(.Rows.Count, 1).End(xlUp).Row
  Set idA = .Range("A2").Resize(x - 1)
  .Cells(2, "CO").Resize(x - 1).ClearContents
  ReDim v(1 To x - 1, 1 To 1)
 End With

 With Sheets("年調DATA")
  z = .Cells(1, .Columns.Count).End(xlToLeft).Column
  For Each colA In .Range("B1").Resize(54, z - 1).Columns
   If colA.Cells(YOUHI).Value = "年末調整する" Then
    If colA.Cells(KANPU).Value > 0 Then
     amt = colA.Cells(KANPU).Value * -1
    Else
     amt = colA.Cells(FUSOKU).Value
    End If
    ck = Application.Match(colA.Cells(ID).Value, idA, 0)
    If IsNumeric(ck) Then
     v(ck, 1) = amt
    End If
   End If
  Next
 End With

 With Sheets("最終支給台帳")
  .Range("CO2").Resize(x - 1) = v
  .Range("CQ2").Resize(x - 1).Formula = "=BZ2+CB2+CC2+CO2+CP2"
  .Range("CR2").Resize(x - 1).Formula = "=BL2-CQ2"
 End With

 Set idA = Nothing

 MsgBox "処理が完了しました"

End Sub

【67632】Re:様式の異なるシート間での値の抽出と...
お礼  八家九僧陀  - 10/12/20(月) 0:09 -

引用なし
パスワード
   ▼UO3 さん:
大変返事が遅くなり申し訳ありません。
ただいま仕事から戻りました。
その間何度もご教示をいただき、本当に本当にありがとうございます。

●本日最初の質問ですが、
・各列は、計算させてセットする列ですので、処理前に、いったん列の値をクリアしています。(対象外の行については、これらの列の値は空白になります。)
→分かりました。
・対象外以外の行については、その前に入っていた値を残したいということなら
 クリアしている部分を削除しますが、要件としては、どちらでしょう?
→12月月給処理で12月の支給額、社会保険料、源泉徴収税を一旦算出して、それぞれの額を11月までの支給額、社会保険料、徴収税に加算して1年間の合計を集計して年末調整するようにしていますが、基本的に年末調整しない人は12月分のデータのままとします。=従って年末調整により徴収税に過不足がある人のみ、12月の徴収税額が変更となり差引支給額も変動させる予定です。結果的に「その前に入っていた値を残」すことになるちょ考えています。

・★CO列には何かセットされましたか? 
→全部が空白となってしまい、CO列にも「何もセットされ」ませんでした。


●本日2、3番目の質問ですが
・13行目の要否指定の文字列については、ご確認をお願いします。
実際に記入しておられる文字列は Yes,No とか 要、不要 等かもしれませんね。
最終的には実際に使っている文字列にコードをあわせましょう。
→「甲欄年調あり」「甲欄年調なし」「乙欄」の3つの選択枝がり、「甲欄年調あり」の者のみ年税額を計算する処理をさせています。


★ところで、シートのイメージをよくよく思い返していましたら
 CO列は、対象者のみが値を持ち、それ以外の人は空白でいいと思いますが
 CQ列、CR列は、全部の人が対象だということに思い当たりました。
 方法は2つあります。いずれがよろしいですか?

 1)対象者のみを置き換え、そのほかの人達のところは【触らない】
 2)すべての人に対して【再計算させる】
→12月月給処理というプログラムで正規に処理した「支給台帳」データを一旦年調処理プログラム(別bookのsheet)にそのまま値複写して、その徴収税を取り込み、最終的に年税額の過不足額を算出し、その過不足額に、12月支給台帳から取り込んだ12月分徴収税額を差引し、(例えば年税額の算出した結果、3000円の還付額が生じたが、12月徴収税が2000円であれば、差し引きの結果1000円の還付額となり、12月支給額は結果的に1000円プラスの額となる)、その額をもう一度12月支給台帳「最終支給台帳」に返して(最初の取り込み時は3000円であったが、返すときはー1000円という値になる)、差引再計算して支給額を算出する予定です。
結果として1)対象者のみを置き換え、そのほかの人達のところは【触らない】
ということになります。ただ、「甲欄年調あり」の人だけが12月徴収税額に変動が生じ、他の人の値に変動はないので、差引支給額の再計算は、全部の人に対して動作させても差引結果は同じになるので 2)すべての人に対して【再計算させる】
ようにしてもいいと考えます。

長々と勝手なことを書いてしまいました。
こんなにご親切にしていただき、本当に本当に感謝、感謝です。

明日早速下のコードを試させていただきます。
また、明日回答させていただきます。

ただ、バスの運転手をしており、居酒屋の客の送迎も走らなければならず、只今忘年会シーズンの真っ盛りで、夜は遅いは、マイクロバスなのにタクシー扱いで、行きは会社や工場からまとまって乗ってくれるのですが、帰りはひとり一人、あっち、こっちとマイクロバスなのに、まるでタクシー扱いです。しまいにはあっちこっちと走っているうちに自分はいったいどこをどう走っているのか分からなくなり、果たして無事に帰れるのかと不安になるほどです。深夜営業が終わってからFAXが送られてくるので、明日の朝でないと、その居酒屋の送迎があるのかないのか不明です。あればまた帰宅が遅くなり回答が遅れるかもわかりません。ホントに勝手ながらお許しください。
今後も引き続きご教示ください。

【67633】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/20(月) 6:46 -

引用なし
パスワード
   ▼八家九僧陀 さん:

おはようございます。
お試しになるときには、

コードの
If colA.Cells(YOUHI).Value = "年末調整する" Then

If colA.Cells(YOUHI).Value = "甲欄年調あり" Then

にかえてから実行するか、あるいは年調DATAシートのテストデータのほうを
"年末調整する" にして実行してくださいね。

【67647】Re:様式の異なるシート間での値の抽出と...
発言  八家九僧陀  - 10/12/20(月) 22:54 -

引用なし
パスワード
   ▼UO3 さん:
>▼八家九僧陀 さん:
>
>おはようございます。
>お試しになるときには、
>
>コードの
>If colA.Cells(YOUHI).Value = "年末調整する" Then
>を
>If colA.Cells(YOUHI).Value = "甲欄年調あり" Then
>
>にかえてから実行するか、あるいは年調DATAシートのテストデータのほうを
>"年末調整する" にして実行してくださいね。

今日は早く帰宅できました。今日ご教示いただいたコードを「If colA.Cells(YOUHI).Value = "甲欄年調あり" Then」に修正して実行した結果の一例です。

【実行前のデータ】
●CQ列[控除額合計]「33176」 = BZ列[社保控除額]「23926」 + CB列[定額控除]「0」 + CC列[変動控除]「0」 + CO列[源泉徴収税額]「2950」 + CP列[市民税] 「6300」

●CR列[差引支給額]「144824」 = BL列[総支給額]「178000」 ー CQ列[控除額合計]「33176」

【実行後のデータ】
●CQ列[控除額合計]「30226」 = BZ列[社保控除額]「23926」 + CB列[定額控除]「0」 + CC列[変動控除]「0」 + CO列[源泉徴収税額]「空白」+ CP列[市民税] 「6300」

●CR列[差引支給額]「147774」 = BL列[総支給額]「178000」 ー CQ列[控除額合計]「30226」

【結果】

●実行後 CR列[差引支給額]「147774」- 実行前CR列[差引支給額]「144824」=2950
となり、CO列[源泉徴収税額]「2950」が二重に控除されています。


本来なら、なるべきデータ(甲欄年調ありの場合)
sheets("年調DATA")53行目[還付額]が「3000」となった場合→源泉税を多く徴収しすぎていたので本人にその分を戻す=12月月給の手取り額が増額となる

●CQ列[控除額合計]「27226」 = BZ列[社保控除額]「23926」 + CB列[定額控除]「0」 + CC列[変動控除]「0」 + CO列[源泉徴収税額]「-3000」 (転記した値)+ CP列[市民税] 「6300」

●CR列[差引支給額]「150774」 = BL列[総支給額]「178000」 ー CQ列[控除額合計]「27226」

「本来なら、なるべきデータ」のとおり、CO列[源泉徴収税額]には[-3000]のデータが代入され、それを通常通りに加減した値が、CQ列[控除額合計]とCR列[差引支給額]に反映されるというふうにしたいのですが???

引き続きご教示をお願いします。

【67660】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/21(火) 18:22 -

引用なし
パスワード
   ▼八家九僧陀 さん:

確認させてください。
実行前のデータは、計算されなおしますから、問題は、実行した結果と【あるべき姿】の差異ですね。

二重に控除されているというより、アップいただいた例でいいますと、
>【実行後のデータ】 CO列[源泉徴収税額]「空白
>本来なら、なるべきデータ(甲欄年調ありの場合)CO列[源泉徴収税額]「-3000」

違いはここですね。
つまり、本来3,000円の控除なのに空白になっている、なので計算結果が3,000円少ない。

コードをチェックして見ますが、
・この例の【53行目】に、確かに3,000円と入っていますか?
・この例の【13行目】に、確かに "甲欄年調あり" と正しい文字列で入っていますか?

【67670】Re:様式の異なるシート間での値の抽出と...
発言  八家九僧陀  - 10/12/22(水) 17:44 -

引用なし
パスワード
   ▼UO3 さん:
ご迷惑をお掛けします。

>
>確認させてください。
>実行前のデータは、計算されなおしますから、問題は、実行した結果と【あるべき姿】の差異ですね。
>
>二重に控除されているというより、アップいただいた例でいいますと、
>>【実行後のデータ】 CO列[源泉徴収税額]「空白
>>本来なら、なるべきデータ(甲欄年調ありの場合)CO列[源泉徴収税額]「-3000」
>
>違いはここですね。
>つまり、本来3,000円の控除なのに空白になっている、なので計算結果が3,000円少ない。
>
>コードをチェックして見ますが、
>・この例の【53行目】に、確かに3,000円と入っていますか?
>・この例の【13行目】に、確かに "甲欄年調あり" と正しい文字列で入っていますか?

年調DATAシートに表示させている行列番号では、13行目、53行目の行に確実に入力されています。
試しにその前後の行に入れ替えて実行しても結果は同じです。

「甲欄年調あり」「甲欄年調なし」「乙欄」の文字列を認識していないのでしょうか?

当該データを読み込んでいるかチェックできるMsgBoxを加えて確認できるコードを教えていただけますか?

【67671】Re:様式の異なるシート間での値の抽出と...
発言  UO3  - 10/12/22(水) 18:14 -

引用なし
パスワード
   ▼八家九僧陀 さん:

お疲れ様です。
MSGBOXより、ステップ実行はご存知でしょうか。
まず、4〜5人分のテストデータで試してください。

・VBE画面を開きます。
プロシジャの、どこでもいいですからカーソルをおいて、F8を押します。
最初の行が黄色くハイライトしますので、以降、F8を押していってください。
押すたびに実行コードが動いていきます。

おそらく、からぶりしているのは
ck = Application.Match(colA.Cells(ID).Value, idA, 0)
    If IsNumeric(ck) Then
ここじゃないかと想定されます。

念のためなんですが、シートの比較は、氏名ではなく社員IDで行っています。
年調DATAの1行目にある社員IDと、最終支給台帳のA列の社員ID、これらは
ちゃんとマッチする文字列になっているでしょうか?

たとえば、一方が 1,2,3 他方が 0001,0002,0003 となっていればマッチしません。

【67674】Re:様式の異なるシート間での値の抽出と...
お礼  八家九僧陀  - 10/12/23(木) 21:53 -

引用なし
パスワード
   ▼UO3 さん:
本当にいろいろご面倒をおかけして有難うございました。
ステップ実行をしましたが、黄色い帯が上下するだけで、どこがどうなのかさっぱり分かりませんでした。
私にはとても難解なコードで、どこがどう悪いのか見当もつかぬまま、とうとう年末調整事務に突入してしまい、自分なりに、いままで習得した単純なコードで、
1.「甲欄年調あり」の者の「社員ID」、「氏名」、「税」の3項目をまず抽出して一覧表にする。
2.最終支給台帳の社員IDとその一覧表の社員IDと一致した場合に、最終支給台帳の当該行の当該セルに「税」を代入する。
3.2.のあと最終支給台帳の全行に対して数式(加算、差引)をLoopする
コマンドボタンにより1.→2.→3.と各プロシージャーを実行するというコードを作成して、とりあえず取り掛かり、なんとかうまくいきそうです。

本当にご親切にいままでお世話いただき有難うございました。

最後の最後まで、せっかくご教示いただいたコードを実行させぬままでございましたが、ひと段落したら改めてこのコードをジックリ試して、勉強にさせてもらいます。

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

また他の内容で質問をさせていただきますので、そのときはまた宜しくお願いします。

2498 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free