```
Sub Macro2()
'
' Macro2 Macro
' "IV(NG)"シートに対する編集マクロ
'帳票ﾀｲﾌﾟを選択していない場合、インデックスエラーが出るのでポップアップを表示する
If Sheet1.ReportTypeComboBox.Text = "" Then
MsgBox "帳票タイプを選択してください。", Buttons:=vbExclamation
End
End If
'no.3/no4の場合、inch数の入力がなければエラーメッセージを表示する
If Range("N12") = "" And (Sheet1.ReportTypeComboBox.Text = "no.3 - TOPPAN PRINTING CO.,LTD. - Mutto" Or Sheet1.ReportTypeComboBox.Text = "no.4 - TOPPAN INC - TES") Then
MsgBox "inch数を貼り付けてください。", Buttons:=vbExclamation
End
End If
If Sheet1.ReportTypeComboBox.Text <> "no.5 - VTS-Touchsensor Co., Ltd. - VIA" Then
Windows("ToppanVTS書類作成マクロv1.8.xlsm").Activate
Sheets("Sheet1").Select
'張り付けた本文をコピー
Range("M12:M83").NumberFormatLocal = "G/標準"
Range("M12").Select
ActiveCell.FormulaR1C1 = "=ASC(RC[-1])"
Range("M12:M83").FillDown
Range("M12:M83").Copy
Range("L12:L83").Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("M12:M83").ClearContents
Range("L12:L83").Select
Selection.TextToColumns Destination:=Range("L12"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End If
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1"
'成形したメール本文をPL.xlsxへコピー後、削除
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_2"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_3"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_4"
ActiveWorkbook.Save
End Sub
Sub Macro2_1()
'
' Macro2_1 Macro
' マクロに張り付けた実績データを整形、IV(NG)シートを作成
'
Windows("ToppanVTS書類作成マクロv1.8.xlsm").Activate
Sheets("Sheet1").Select
Range("L12").Select
With Sheet1.ReportTypeComboBox
If .Text = "no.1 - TOPPAN INC - Henghao" Then
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_1_formating"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_1_paste"
ElseIf .Text = "no.2 - VTS-Touchsensor Co., Ltd. - Mutto" Then
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_2_formating"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_2_paste"
ElseIf .Text = "no.3 - TOPPAN PRINTING CO.,LTD. - Mutto" Then
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_3_formating"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_3_paste"
ElseIf .Text = "no.4 - TOPPAN INC - TES" Then
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_4_formating"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_4_paste"
ElseIf .Text = "no.5 - VTS-Touchsensor Co., Ltd. - VIA" Then
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_5_formating"
Application.Run "ToppanVTS書類作成マクロv1.8.xlsm!Macro2_1_5_paste"
End If
End With
End Sub
Sub Macro2_1_1_formating()
'
' Macro2_1_1_formating Macro
' 帳票タイプ：no.1 - TOPPAN INC - Henghao
' 貼り付けたメール本文を整形する
'
'1
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'2
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'3
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'4
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'5
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'6
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'7
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'8
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
'9
If ActiveCell.Offset(4, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(5, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B2").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(6, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B3").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(7, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B4").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
ElseIf ActiveCell.Offset(8, 0).Range("A1") = "･PART#" Then
ActiveCell.Offset(3, 0).Range("A1:B5").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(2, 0).Range("A1").Select
End If
End Sub
Sub Macro2_1_1_paste()
'
' Macro2_1_1_pl Macro
' 帳票タイプ：no.1 - TOPPAN INC - Henghao
' Macro2_1_1_formatingで整形した文をPL.xlsxへ貼付する
'
'1
Range("O12").NumberFormatLocal = "G/標準"
Range("O12") = "=TEXT(MID(M12,4,3)/10,""0.0"")"
Range("M13").Select
Selection.TextToColumns Destination:=Range("M13"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M13"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M13"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Range("M14").Select
Selection.TextToColumns Destination:=Range("M14"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M14"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
'2
If Range("L17") = "･品名" Then
Range("O12").Copy Destination:=Range("O17")
Range("M18").Select
Selection.TextToColumns Destination:=Range("M18"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M18"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M18"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Range("M19").Select
Selection.TextToColumns Destination:=Range("M19"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M19"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'3
If Range("L22") = "･品名" Then
Range("O17").Copy Destination:=Range("O22")
Range("M23").Select
Selection.TextToColumns Destination:=Range("M23"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M23"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M23"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Range("M24").Select
Selection.TextToColumns Destination:=Range("M24"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M24"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'4
If Range("L27") = "･品名" Then
Range("O22").Copy Destination:=Range("O27")
Range("M28").Select
Selection.TextToColumns Destination:=Range("M28"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M28"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M28"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9)), _
TrailingMinusNumbers:=True
Range("M29").Select
Selection.TextToColumns Destination:=Range("M29"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M29"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'5
If Range("L32") = "･品名" Then
Range("O27").Copy Destination:=Range("O32") '5～8のインチ数取得箇所修正
Range("M33").Select
Selection.TextToColumns Destination:=Range("M33"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M33"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M33"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Range("M34").Select
Selection.TextToColumns Destination:=Range("M34"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M34"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'6
If Range("L37") = "･品名" Then
Range("O32").Copy Destination:=Range("O37")
Range("M38").Select
Selection.TextToColumns Destination:=Range("M38"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M38"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M38"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Range("M39").Select
Selection.TextToColumns Destination:=Range("M39"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M39"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'7
If Range("L42") = "･品名" Then
Range("O37").Copy Destination:=Range("O42")
Range("M43").Select
Selection.TextToColumns Destination:=Range("M43"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M43"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M43"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Range("M44").Select
Selection.TextToColumns Destination:=Range("M44"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M44"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'8
If Range("L47") = "･品名" Then
Range("O42").Copy Destination:=Range("O47")
Range("M48").Select
Selection.TextToColumns Destination:=Range("M48"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M48"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M48"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Range("M49").Select
Selection.TextToColumns Destination:=Range("M49"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M49"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
'9
If Range("L52") = "･品名" Then
Range("O52").Copy Destination:=Range("O57")
Range("M53").Select
Selection.TextToColumns Destination:=Range("M53"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 9), Array(2, 1)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M53"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="p", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M53"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 9), Array(3, 9)), _
TrailingMinusNumbers:=True
Range("M54").Select
Selection.TextToColumns Destination:=Range("M54"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="×", FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Range("M54"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="u", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
End If
Range("L12:O83").Select
Selection.Copy
Windows("PL.xlsx").Activate
Sheets("IV(NG)").Select
Range("N37:Q109").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("C37:C92").NumberFormatLocal = "G/標準"
'1
Range("C37") = "=CONCATENATE(Q37,"""""" Cu Film Sensor For Touch Panels"")"
Range("C38") = "=CONCATENATE(""Part No.:"",O40)"
Range("C39") = "=O37"
Range("C40") = "NO COMMERCIAL VALUE"
Range("G39") = "=O38"
Range("I39") = "=O39"
'2
If Range("N42") <> "" Then
Range("C43") = "=CONCATENATE(Q42,"""""" Cu Film Sensor For Touch Panels"")"
Range("C44") = "=CONCATENATE(""Part No.:"",O45)"
Range("C45") = "=O42"
Range("C46") = "NO COMMERCIAL VALUE"
Range("G45") = "=O43"
Range("I45") = "=O44"
Else
Range("C36").Select
End If
'3
If Range("N47") <> "" Then
Range("C49") = "=CONCATENATE(Q47,"""""" Cu Film Sensor For Touch Panels"")"
Range("C50") = "=CONCATENATE(""Part No.:"",O50)"
Range("C51") = "=O47"
Range("C52") = "NO COMMERCIAL VALUE"
Range("G51") = "=O48"
Range("I51") = "=O49"
Else
Range("C36").Select
End If
'4
If Range("N52") <> "" Then
Range("C55") = "=CONCATENATE(Q52,"""""" Cu Film Sensor For Touch Panels"")"
Range("C56") = "=CONCATENATE(""Part No.:"",O55)"
Range("C57") = "=O52"
Range("C58") = "NO COMMERCIAL VALUE"
Range("G57") = "=O53"
Range("I57") = "=O54"
Else
Range("C36").Select
End If
'5
If Range("N57") <> "" Then
Range("C61") = "=CONCATENATE(Q57,"""""" Cu Film Sensor For Touch Panels"")"
Range("C62") = "=CONCATENATE(""Part No.:"",O60)"
Range("C63") = "=O57"
Range("C64") = "NO COMMERCIAL VALUE"
Range("G63") = "=O58"
Range("I63") = "=O59"
Else
Range("C36").Select
End If
'6
If Range("N62") <> "" Then
Range("C67") = "=CONCATENATE(Q62,"""""" Cu Film Sensor For Touch Panels"")"
Range("C68") = "=CONCATENATE(""Part No.:"",O65)"
Range("C69") = "=O62"
Range("C70") = "NO COMMERCIAL VALUE"
Range("G69") = "=O63"
Range("I69") = "=O64"
Else
Range("C36").Select
End If
'7
If Range("N67") <> "" Then
Range("C73") = "=CONCATENATE(Q67,"""""" Cu Film Sensor For Touch Panels"")"
Range("C74") = "=CONCATENATE(""Part No.:"",O70)"
Range("C75") = "=O67"
Range("C76") = "NO COMMERCIAL VALUE"
Range("G75") = "=O68"
Range("I75") = "=O69"
Else
Range("C36").Select
End If
'8
If Range("N72") <> "" Then
Range("C79") = "=CONCATENATE(Q72,"""""" Cu Film Sensor For Touch Panels"")"
Range("C80") = "=CONCATENATE(""Part No.:"",O75)"
Range("C81") = "=O72"
Range("C82") = "NO COMMERCIAL VALUE"
Range("G81") = "=O73"
Range("I81") = "=O74"
Else
Range("C36").Select
End If
'9
If Range("N77") <> "" Then
Range("C85") = "=CONCATENATE(Q77,"""""" Cu Film Sensor For Touch Panels"")"
Range("C86") = "=CONCATENATE(""Part No.:"",O80)"
Range("C87") = "=O77"
Range("C88") = "NO COMMERCIAL VALUE"
Range("G87") = "=O78"
Range("I87") = "=O79"
Else
Range("C36").Select
End If
End Sub
Sub Macro2_1_2_formating()
'
' Macro2_1_2_formating Macro
' 帳票タイプ：no.2 - VTS-Touchsensor Co., Ltd. - Mutto
' 貼り付けたメール本文で不要な項目を削除する
'
Dim hinmeiCount As String
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("L12:L102"), "品名")
'1
If ActiveCell.Offset(2, 0).Range("A1") = "得意先品名" Then
ActiveCell.Offset(3, 0).Range("A1:C1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(1, 0).Range("A1:C1").Select
Selection.Delete Shift:=xlUp
End If
Range("L12").Select
Selection.Characters(1, 1).Delete
Selection = Replace(Selection.Range("A1"), ChrW(160), "")
Selection = Trim(Selection.Text)
'単価
'2022/8/29 - 有償・無償のpcsはBSiシートより取得するため削除
' ActiveCell.Offset(3, 1).Range("A1").Select
' Selection.TextToColumns Destination:=Range("M15"), DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
' OtherChar:="､", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
' Selection.TextToColumns Destination:=Range("M15"), DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
' OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
' TrailingMinusNumbers:=True
' ActiveCell.Offset(3, 1).Range("A1").Select
Range("M15") = Replace(Range("M15"), "USD", "")
If Range("M15") Like "*無償*" Then
Range("M15") = Replace(Range("M15"), "無償(", "")
End If
If Range("M15") Like "*pcs*" Then
Range("M15") = Replace(Range("M15"), "pcs)", "")
End If
If Range("M15") Like "*(*" Then '2023/3/7 add
Range("M15").TextToColumns Destination:=Range("M15"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 9)), TrailingMinusNumbers:=True
End If
ActiveCell.Offset(3, 1).Range("A1").Select
'P/O NOを削除
ActiveCell.Offset(1, -1).Range("A1").Select
For i = 1 To 5
If Selection Like "PO*" Then
ActiveCell.Offset(0, 1).Range("A1").TextToColumns Destination:=ActiveCell.Offset(0, 1).Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(0, 1).Range("A1") = Trim(ActiveCell.Offset(0, 1).Range("A1").Text)
ActiveCell.Offset(1, 0).Range("A1").Select
ElseIf Selection Like "*pcs)" Then
ActiveCell.Offset(0, 1).Range("A1") = Selection
ActiveCell.Offset(0, 1).Range("A1") = Trim(ActiveCell.Offset(0, 1).Range("A1").Text)
Selection.ClearContents
Selection = "PO"
Else
Exit For
End If
Next i
'余分なブランク行を削除する
If ActiveCell.Offset(1, 0).Range("A1") = "" Then
ActiveCell.Offset(1, 0).Range("A1:B1").Delete Shift:=xlUp
End If
'タイトル表記がない場合は付け加える
' If ActiveCell.Offset(-1, 0).Range("A1") <> "PO" Then
' ActiveCell.Offset(-1, 0).Range("A1") = Trim(ActiveCell.Offset(-1, 0).Range("A1").Text)
' ActiveCell.Offset(-1, 1).Range("A1") = ActiveCell.Offset(-1, 0).Range("A1")
' ActiveCell.Offset(-1, 0).Range("A1") = "PO"
' End If
ActiveCell.Offset(1, 0).Range("A1").Select
'2~9
For c = 2 To hinmeiCount
If ActiveCell.Offset(2, 0).Range("A1") = "得意先品名" Then
ActiveCell.Offset(3, 0).Range("A1:C1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(1, 0).Range("A1:C1").Select
Selection.Delete Shift:=xlUp
End If
ActiveCell.Offset(-4, 0).Range("A1").Select
Selection.Characters(1, 1).Delete
Selection = Replace(Selection.Range("A1"), ChrW(160), "")
Selection = Trim(Selection.Text)
'単価
ActiveCell.Offset(3, 1).Range("A1").Select
' Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
' OtherChar:="､", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
' Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
' OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
' TrailingMinusNumbers:=True
Selection = Replace(Selection, "USD", "")
If ActiveCell.Offset(0, 1).Range("A1") Like "*無償*" Then
ActiveCell.Offset(0, 1).Range("A1") = Replace(ActiveCell.Offset(0, 1).Range("A1"), "無償(", "")
End If
If ActiveCell.Offset(0, 1).Range("A1") Like "*pcs*" Then
ActiveCell.Offset(0, 1).Range("A1") = Replace(ActiveCell.Offset(0, 1).Range("A1"), "pcs)", "")
End If
' ActiveCell.Offset(0, 1).Range("A1") = Replace(ActiveCell.Offset(0, 1).Range("A1"), "無償(", "")
' ActiveCell.Offset(0, 1).Range("A1") = Replace(ActiveCell.Offset(0, 1).Range("A1"), "pcs)", "")
'P/O NOを削除
ActiveCell.Offset(1, -1).Range("A1").Select
For i = 1 To 5
If Selection = "PO" Then
ActiveCell.Offset(0, 1).Range("A1").TextToColumns Destination:=ActiveCell.Offset(0, 1).Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(0, 1).Range("A1") = Trim(ActiveCell.Offset(0, 1).Range("A1").Text)
ActiveCell.Offset(1, 0).Range("A1").Select
ElseIf Selection Like "*pcs)" Then
ActiveCell.Offset(0, 1).Range("A1") = Selection
ActiveCell.Offset(0, 1).Range("A1") = Trim(ActiveCell.Offset(0, 1).Range("A1").Text)
Selection.ClearContents
Selection = "PO"
Else
Exit For
End If
Next i
'余分なブランク行を削除する
If ActiveCell.Offset(1, 0).Range("A1") = "" Then
ActiveCell.Offset(1, 0).Range("A1:B1").Delete Shift:=xlUp
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Next c
End Sub
Sub Macro2_1_2_paste()
'
' Macro2_1_2_paste Macro
' 帳票タイプ：no.2 - VTS-Touchsensor Co., Ltd. - Mutto
' Macro2_1_1_fomating, Macro2_1_2_fomatingにて整形したデータをPL.xlsxへ貼付する
'
Dim poCount As Integer
'NG計算用
Dim hinmeiData As String
Dim hinmeiRow As String
Dim hinmeiEndRow As String
Dim quantityData As String
Dim quantitySum As String
poCount = 0
Range("L12:O83").Select
Selection.Copy
Windows("PL.xlsx").Activate
Sheets("IV(NG)").Select
Range("N37:Q109").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B38:B92").ClearContents
Range("C37:C92").NumberFormatLocal = "G/標準"
Range("N37:Q109").NumberFormatLocal = "G/標準"
'1
Range("C37") = "=N37"
'NGの合計数を取得
hinmeiData = Range("O38")
Sheets("PL").Select
hinmeiRow = Range("B35:B127").Find(hinmeiData).row
hinmeiEndRow = Range("P" & hinmeiRow).End(xlDown).Offset(-1, 0).row
quantitySum = Application.WorksheetFunction.Sum(Range("S" & hinmeiRow & ":S" & hinmeiEndRow))
Sheets("IV(NG)").Select
Range("G38") = quantitySum
'PO 2023/3/7 delete
' Range("C38") = "=CONCATENATE(""PO:"",R[3]C[12])"
' Range("G38") = "=R[2]C[9]"
Range("I38:J38") = "=R[2]C[6]"
' poCount = poCount + 1
' Range("N42").Select
' For i = 1 To 5
' If Selection = "PO" Then
' Range("C" & 38 + i) = "=CONCATENATE(""PO:"",R[3]C[12])"
' poCount = poCount + 1
'
' ActiveCell.Offset(1, 0).Range("A1").Select
' ElseIf Selection = "" Then
' Exit For
' End If
' Next i
Range("C38").Select
'品名を貼付
Selection = "=O38"
'得意先顧客名を貼付
ActiveCell.Offset(1, 0).Range("A1").Select
Selection = "=O39"
Selection = Trim(Selection.Text)
ActiveCell.Offset(1, 0).Range("A1") = "NO COMMERCIAL VALUE"
'2~9
Dim lineRow As String 'POの数カウント用
Dim activeRow As String 'POの数カウント用
Dim poCountBack As String '前のDISCRIPTIONのPOの数
Dim poCountNext As String '今のDISCRIOTIONのPOの数
Dim dataCount As String 'DISCRIOTIONの数
Dim headRow As String 'POが複数ある場合、先頭データ位置を取得する
Dim dataList() As Variant 'DISCRIPTIONのデータを格納する配列
'配列を初期化する
Dim description() As Variant: description = Array()
Dim hinmei() As Variant: hinmei = Array()
Dim tokuisaki() As Variant: tokuisaki = Array()
Dim tanka() As Variant: tanka = Array()
' Dim PO() As Variant: PO = Array()
' Dim po2() As Variant: po2 = Array()
' Dim po3() As Variant: po3 = Array()
' Dim po4() As Variant: po4 = Array()
' Dim po5() As Variant: po5 = Array()
dataList = Range("N37:P109").value '1題目、2品名、3得意先品名、4単価、5PO、6空行
dataCount = WorksheetFunction.CountIf(Range("N37:Q109"), "品名")
ActiveCell.Offset(1, 0).Range("A1").Select
If dataCount > 1 Then
For i = 2 To dataCount
ActiveCell.Offset(2, -1).Range("A1").Select
Selection = "'1-" & i
lineRow = Range("B35:B92").Find("1-" & i - 1).row
activeRow = ActiveCell.row
' poCountBack = WorksheetFunction.CountIf(Range("B" & lineRow & ":F" & activeRow), "PO:*") '貼り付け済データのPOカウント
'配列から値を取り出す
If i = 2 Then
description = WorksheetFunction.index(dataList, 1, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 2, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 3, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 4, 0) '単価
' PO = WorksheetFunction.index(dataList, 10 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 11 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 12 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 13 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 14 + poCountBack, 0) 'PO5
ElseIf i = 3 Then
description = WorksheetFunction.index(dataList, 7, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 8, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 9, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 10, 0) '単価
' PO = WorksheetFunction.index(dataList, 17 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 18 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 19 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 20 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 21 + poCountBack, 0) 'PO5
ElseIf i = 4 Then
description = WorksheetFunction.index(dataList, 13, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 14, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 15, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 16, 0) '単価
' PO = WorksheetFunction.index(dataList, 24 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 25 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 26 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 27 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 28 + poCountBack, 0) 'PO5
ElseIf i = 5 Then
description = WorksheetFunction.index(dataList, 19, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 20, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 21, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 22, 0) '単価
' PO = WorksheetFunction.index(dataList, 31 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 32 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 33 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 34 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 35 + poCountBack, 0) 'PO5
ElseIf i = 6 Then
description = WorksheetFunction.index(dataList, 25, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 26, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 27, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 28, 0) '単価
' PO = WorksheetFunction.index(dataList, 38 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 39 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 40 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 41 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 42 + poCountBack, 0) 'PO5
ElseIf i = 7 Then
description = WorksheetFunction.index(dataList, 31, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 32, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 33, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 34, 0) '単価
' PO = WorksheetFunction.index(dataList, 45 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 46 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 47 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 48 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 49 + poCountBack, 0) 'PO5
ElseIf i = 8 Then
description = WorksheetFunction.index(dataList, 37, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 38, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 39, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 40, 0) '単価
' PO = WorksheetFunction.index(dataList, 52 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 53 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 54 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 55 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 56 + poCountBack, 0) 'PO5
ElseIf i = 9 Then
description = WorksheetFunction.index(dataList, 43, 0) 'DESCRIPTION
hinmei = WorksheetFunction.index(dataList, 44, 0) '品名
tokuisaki = WorksheetFunction.index(dataList, 45, 0) '得意先品名
tanka = WorksheetFunction.index(dataList, 46, 0) '単価
' PO = WorksheetFunction.index(dataList, 59 + poCountBack, 0) 'PO
' po2 = WorksheetFunction.index(dataList, 60 + poCountBack, 0) 'PO2
' po3 = WorksheetFunction.index(dataList, 61 + poCountBack, 0) 'PO3
' po4 = WorksheetFunction.index(dataList, 62 + poCountBack, 0) 'PO4
' po5 = WorksheetFunction.index(dataList, 63 + poCountBack, 0) 'PO5
End If
'POが存在しない場合、配列を初期化する
' If po2(2) = "" Then
' po2 = Array()
' po3 = Array()
' po4 = Array()
' po5 = Array()
' poCountNext = 1
' ElseIf po3(2) = "" Then
' po3 = Array()
' po4 = Array()
' po5 = Array()
' poCountNext = 2
' ElseIf po4(2) = "" Then
' po4 = Array()
' po5 = Array()
' poCountNext = 3
' ElseIf po5(2) = "" Then
' po5 = Array()
' poCountNext = 4
' Else
' poCountNext = 5
' End If
ActiveCell.Offset(0, 1).Range("A1").Select
Selection = description(1)
Selection = Trim(Selection.Text)
Sheets("PL").Select
hinmeiRow = Range("B35:B92").Find(hinmeiData).row
hinmeiEndRow = Range("B" & hinmeiRow).End(xlDown).Offset(-1, 0).row
quantitySum = Application.WorksheetFunction.Sum(Range("S" & hinmeiRow & ":S" & hinmeiEndRow))
Sheets("IV(NG)").Select
'PO
ActiveCell.Offset(1, 0).Range("A1").Select
'Selection = "=CONCATENATE(""PO:""," & PO(2) & ")" 'PO
ActiveCell.Offset(0, 4).Range("A1") = quantitySum 'QUANTITY
ActiveCell.Offset(0, 6).Range("A1:B1") = tanka(2) 'UNIT PRICE
headRow = ActiveCell.Offset(0, 0).Range("A1").row
'貼付データからPOを選択
' Range("C" & headRow).Select
' For P = 1 To poCountNext - 1
' Range("C" & headRow + P) = "=CONCATENATE(""PO:"",R[3]C[12])"
' ActiveCell.Offset(1, 0).Range("A1").Select
' Next P
ActiveCell.Offset(0, 0).Range("A1") = hinmei(2) '品名
ActiveCell.Offset(1, 0).Range("A1").Select '得意先顧客名
Selection = tokuisaki(2)
Selection = Trim(Selection.Text)
ActiveCell.Offset(1, 0).Range("A1") = "NO COMMERCIAL VALUE"
ActiveCell.Offset(1, 0).Range("A1").Select
Next i
End If
With Range("G37:G92") '2023/3/15 mod
.NumberFormatLocal = "#,###"
.value = .value
End With
With Range("I37:J92")
.NumberFormatLocal = """US$""#,##0.00;[赤]-""US$""#,##0.00"
.value = .value
End With
End Sub
Sub Macro2_1_3_formating()
'
' Macro2_1_3_formating Macro
' 帳票タイプ：no.3 - TOPPAN PRINTING CO.,LTD. - Mutto
' 貼り付けたメール本文で不要な項目を削除する
'
Dim inchCount As String
Dim hinmeiCount As String
Dim poCount As String
'インチ数を整形する
Range("N12").Select
Selection = Replace(Selection, """", "")
'1
For i = 0 To 89
Range("L" & 12 + i).Select
If Selection <> "" Then
Selection = Replace(Selection.Range("A1"), ChrW(160), "") '品名~金額
Selection = Trim(Selection.Text)
End If
Next i
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("L12:L102"), "*品名*")
Range("L15").Select
'POをカウント
If ActiveCell.Offset(4, 0).Range("A1") = "･PO" And ActiveCell.Offset(4, 1).Range("A1") <> "" Then
poCount = 5
ElseIf ActiveCell.Offset(3, 0).Range("A1") = "･PO" And ActiveCell.Offset(3, 1).Range("A1") <> "" Then
poCount = 4
ElseIf ActiveCell.Offset(2, 0).Range("A1") = "･PO" And ActiveCell.Offset(2, 1).Range("A1") <> "" Then
poCount = 3
ElseIf ActiveCell.Offset(1, 0).Range("A1") = "･PO" And ActiveCell.Offset(1, 1).Range("A1") <> "" Then
poCount = 2
Else
poCount = 1
End If
Range("L12").Select
ActiveCell.Offset(1, 1).Range("A1").Select '数量
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, -1).Range("A1").Select '金額
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="×", FieldInfo:=Array(Array(1, 9), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection = Replace(Selection, "USD", "")
ActiveCell.Offset(0, 1).Range("A1").Select
Selection = Replace(Selection, "pcs=", "")
Selection = Replace(Selection, "USD", "")
ActiveCell.Offset(1, -2).Range("A1").Select 'POを選択
For i = 0 To poCount - 1
If ActiveCell.Offset(0 + i, 1).Range("A1") Like "*pcs)*" Then
ActiveCell.Offset(0 + i, 1).TextToColumns Destination:=ActiveCell.Offset(0 + i, 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="(", FieldInfo:=Array(Array(1, 2), Array(2, 2)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(0 + i, 2).Range("A1") = Replace(ActiveCell.Offset(0 + i, 2).Range("A1"), "pcs)", "")
End If
Next i
ActiveCell.Offset(poCount + 1, 0).Range("A1").Select
'2~9
For r = 2 To hinmeiCount
ActiveCell.Offset(1, 1).Range("A1").Select '数量
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
ActiveCell.Offset(1, -1).Range("A1").Select '金額
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="×", FieldInfo:=Array(Array(1, 9), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection = Replace(Selection, "USD", "")
ActiveCell.Offset(0, 1).Range("A1").Select
Selection = Replace(Selection, "pcs=", "")
Selection = Replace(Selection, "USD", "")
'POを選択
ActiveCell.Offset(1, -2).Range("A1").Select
'POをカウント
If ActiveCell.Offset(4, 0).Range("A1") = "･PO" And ActiveCell.Offset(4, 1).Range("A1") <> "" Then
poCount = 5
ActiveCell.Offset(6, 0).Range("A1").Select
ElseIf ActiveCell.Offset(3, 0).Range("A1") = "･PO" And ActiveCell.Offset(3, 1).Range("A1") <> "" Then
poCount = 4
ActiveCell.Offset(5, 0).Range("A1").Select
ElseIf ActiveCell.Offset(2, 0).Range("A1") = "･PO" And ActiveCell.Offset(2, 1).Range("A1") <> "" Then
poCount = 3
ActiveCell.Offset(4, 0).Range("A1").Select
ElseIf ActiveCell.Offset(1, 0).Range("A1") = "･PO" And ActiveCell.Offset(1, 1).Range("A1") <> "" Then
poCount = 2
ActiveCell.Offset(3, 0).Range("A1").Select
Else
poCount = 1
ActiveCell.Offset(2, 0).Range("A1").Select
End If
Next r
End Sub
Sub Macro2_1_3_paste()
'
' Macro2_1_3_paste Macro
' 帳票タイプ：no.3 - TOPPAN PRINTING CO.,LTD. - Mutto
' Macro2_1_3_fomatingにて整形したデータをPL.xlsxへ貼付する
'
Dim hinmeiCount As String
Dim poCountBack As String
Dim poCountNext As String
Dim dataList() As Variant
Dim hinmei() As Variant: hinmei = Array()
Dim suuryo() As Variant: suuryo = Array()
Dim kingaku() As Variant: kingaku = Array()
Dim PO() As Variant: PO = Array()
Dim po2() As Variant: po2 = Array()
Dim po3() As Variant: po3 = Array()
Dim po4() As Variant: po4 = Array()
Dim po5() As Variant: po5 = Array()
Range("L12:N83").Select
Selection.Copy
Windows("PL.xlsx").Activate
Sheets("IV(NG)").Select
Range("N37:P109").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B38:B92").ClearContents
Range("B38:L92").Font.Bold = False
Range("C37:C92").NumberFormatLocal = "G/標準"
Range("N37:P109").NumberFormatLocal = "G/標準"
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("N37:N92"), "*品名*")
'1
'PO1を貼り付け
Range("C37").Select
Selection = "=CONCATENATE(P37,"""""" Cu Film Sensor For Touch Panels"")"
Range("C38").Select
Selection = "=CONCATENATE(""PO NO:"",O40)"
Range("G38") = "=P38" 'QUANTITY
Range("I38:J38") = "=O39" 'UNIT PRICE
'POをカウント
Range("N40").Select
If ActiveCell.Offset(4, 0).Range("A1") = "･PO" And ActiveCell.Offset(4, 1).Range("A1") <> "" Then
poCountBack = 5
ElseIf ActiveCell.Offset(3, 0).Range("A1") = "･PO" And ActiveCell.Offset(3, 1).Range("A1") <> "" Then
poCountBack = 4
ElseIf ActiveCell.Offset(2, 0).Range("A1") = "･PO" And ActiveCell.Offset(2, 1).Range("A1") <> "" Then
poCountBack = 3
ElseIf ActiveCell.Offset(1, 0).Range("A1") = "･PO" And ActiveCell.Offset(1, 1).Range("A1") <> "" Then
poCountBack = 2
Else
poCountBack = 1
End If
Range("C38").Select
'PO2~5がある場合貼り付け
For i = 2 To poCountBack
ActiveCell.Offset(2, 0).Range("A1").Select
Selection = "=CONCATENATE(""PO NO:"",O4" & i - 1 & ")"
Next i
'品名を貼り付け
ActiveCell.Offset(1, 0).Range("A1").Select
Selection = "=O37"
Selection = Replace(Selection.Range("A1"), ChrW(160), "") '品名
Selection = Trim(Selection.Text)
ActiveCell.Offset(1, 0).Range("A1") = "NO COMMERCIAL VALUE"
ActiveCell.Offset(1, 0).Range("A1").Font.Bold = True
'2~9
dataList = Range("N37:P109").value
ActiveCell.Offset(1, 0).Range("A1").Select
For i = 2 To hinmeiCount
ActiveCell.Offset(2, -1).Range("A1").Select
Selection = "'1-" & i
ActiveCell.Offset(0, 1).Range("A1").Select
Selection = "=CONCATENATE(P37,"""""" Cu Film Sensor For Touch Panels"")"
lineRow = Range("B37:B92").Find("1-" & i - 1).row
activeRow = ActiveCell.row
poCountBack = WorksheetFunction.CountIf(Range("B" & lineRow & ":F" & activeRow), "PO NO:*") '貼り付け済データのPOカウント
'配列から値を取り出す
If i = 2 Then
hinmei = WorksheetFunction.index(dataList, 5 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 6 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 7 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 8 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 9 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 10 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 11 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 12 + poCountBack, 0) 'PO5
ElseIf i = 3 Then
hinmei = WorksheetFunction.index(dataList, 10 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 11 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 12 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 13 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 14 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 15 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 16 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 17 + poCountBack, 0) 'PO5
ElseIf i = 4 Then
hinmei = WorksheetFunction.index(dataList, 15 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 16 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 17 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 18 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 19 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 20 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 21 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 22 + poCountBack, 0) 'PO5
ElseIf i = 5 Then
hinmei = WorksheetFunction.index(dataList, 20 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 21 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 22 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 23 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 24 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 25 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 26 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 27 + poCountBack, 0) 'PO5
ElseIf i = 6 Then
hinmei = WorksheetFunction.index(dataList, 25 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 26 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 27 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 28 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 29 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 30 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 31 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 32 + poCountBack, 0) 'PO5
ElseIf i = 7 Then
hinmei = WorksheetFunction.index(dataList, 30 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 31 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 32 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 33 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 34 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 35 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 36 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 37 + poCountBack, 0) 'PO5
ElseIf i = 8 Then
hinmei = WorksheetFunction.index(dataList, 40 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 41 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 42 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 43 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 44 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 45 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 46 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 47 + poCountBack, 0) 'PO5
ElseIf i = 9 Then
hinmei = WorksheetFunction.index(dataList, 45 + poCountBack, 0) '品名
suuryo = WorksheetFunction.index(dataList, 46 + poCountBack, 0) '数量
kingaku = WorksheetFunction.index(dataList, 47 + poCountBack, 0) '金額
PO = WorksheetFunction.index(dataList, 48 + poCountBack, 0) 'PO
po2 = WorksheetFunction.index(dataList, 49 + poCountBack, 0) 'PO2
po3 = WorksheetFunction.index(dataList, 50 + poCountBack, 0) 'PO3
po4 = WorksheetFunction.index(dataList, 51 + poCountBack, 0) 'PO4
po5 = WorksheetFunction.index(dataList, 52 + poCountBack, 0) 'PO5
End If
'POが存在しない場合、配列を初期化する
If po2(2) = "" Then
po2 = Array()
po3 = Array()
po4 = Array()
po5 = Array()
poCountNext = 1
ElseIf po3(2) = "" Then
po3 = Array()
po4 = Array()
po5 = Array()
poCountNext = 2
ElseIf po4(2) = "" Then
po4 = Array()
po5 = Array()
poCountNext = 3
ElseIf po5(2) = "" Then
po5 = Array()
poCountNext = 4
Else
poCountNext = 5
End If
ActiveCell.Offset(1, 0).Range("A1").Select
If poCountNext = 1 Or 1 < poCountNext Then
Selection = "=CONCATENATE(""PO NO:""," & PO(2) & ")"
ActiveCell.Offset(0, 4).Range("A1") = suuryo(3)
ActiveCell.Offset(0, 6).Range("A1:B1") = kingaku(2)
End If
If poCountNext = 2 Or 2 < poCountNext Then
ActiveCell.Offset(2, 0).Range("A1").Select
Selection = "=CONCATENATE(""PO NO:""," & po2(2) & ")"
ActiveCell.Offset(0, 4).Range("A1") = suuryo(3)
ActiveCell.Offset(0, 6).Range("A1:B1") = kingaku(2)
End If
If poCountNext = 3 Or 3 < poCountNext Then
ActiveCell.Offset(2, 0).Range("A1").Select
Selection = "=CONCATENATE(""PO NO:""," & po3(2) & ")"
ActiveCell.Offset(0, 4).Range("A1") = suuryo(3)
ActiveCell.Offset(0, 6).Range("A1:B1") = kingaku(2)
End If
If poCountNext = 4 Or 4 < poCountNext Then
ActiveCell.Offset(2, 0).Range("A1").Select
Selection = "=CONCATENATE(""PO NO:""," & po4(2) & ")"
ActiveCell.Offset(0, 4).Range("A1") = suuryo(3)
ActiveCell.Offset(0, 6).Range("A1:B1") = kingaku(2)
End If
If poCountNext = 5 Or 5 < poCountNext Then
ActiveCell.Offset(2, 0).Range("A1").Select
Selection = "=CONCATENATE(""PO NO:""," & po5(2) & ")"
ActiveCell.Offset(0, 4).Range("A1") = suuryo(3)
ActiveCell.Offset(0, 6).Range("A1:B1") = kingaku(2)
End If
ActiveCell.Offset(1, 0).Range("A1").Select '品名
Selection = hinmei(2)
Selection = Replace(Selection.Range("A1"), ChrW(160), "")
Selection = Trim(Selection.Text)
ActiveCell.Offset(1, 0).Range("A1").Select
Selection = "NO COMMERCIAL VALUE"
Selection.Font.Bold = True
Next i
With Range("G37:G92") '2023/3/14 mod "#,###"
.NumberFormatLocal = "#,###"
.value = .value
End With
With Range("I37:J92")
.NumberFormatLocal = """US$""#,##0.00;[赤]-""US$""#,##0.00"
.value = .value
End With
End Sub
Sub Macro2_1_4_formating()
'
' Macro2_1_4_formating Macro
' 帳票タイプ：no.4 - TOPPAN INC - TES
' 貼り付けたメール本文で不要な項目を削除する
'
Dim hinmeiCount As String
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("L12:L102"), "*品名*")
'1
Range("M13").Select '数量
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 9), Array(2, 2)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), TrailingMinusNumbers:=True
ActiveCell.Offset(1, 0).Range("A1").Select '金額
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="×", FieldInfo:=Array(Array(1, 9), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection = Replace(Selection, "us", "")
ActiveCell.Offset(1, 0).Range("A1") = Replace(ActiveCell.Offset(1, 0).Range("A1"), ChrW(160), "") 'Part No
ActiveCell.Offset(1, 0).Range("A1") = Trim(ActiveCell.Offset(1, 0).Range("A1").Text)
ActiveCell.Offset(2, -1).Range("A1").Select
'P/O NOを削除
For i = 1 To 5
ActiveCell.Offset(0, 0).Range("A1").Select
If Selection = "･P/O NO" Then
ActiveCell.Offset(0, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
End If
Next i
ActiveCell.Offset(0, 1).Range("A1").Select
'2~9
For j = 2 To hinmeiCount
ActiveCell.Offset(2, 0).Range("A1").Select '数量
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 9), Array(2, 2)), TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="p", FieldInfo:=Array(Array(1, 2), Array(2, 9)), TrailingMinusNumbers:=True
ActiveCell.Offset(1, 0).Range("A1").Select '金額
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="×", FieldInfo:=Array(Array(1, 9), Array(2, 2)), _
TrailingMinusNumbers:=True
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:="/", FieldInfo:=Array(Array(1, 2), Array(2, 9)), _
TrailingMinusNumbers:=True
Selection = Replace(Selection, "us", "")
ActiveCell.Offset(1, 0).Range("A1") = Replace(ActiveCell.Offset(1, 0).Range("A1"), ChrW(160), "") 'Part No
ActiveCell.Offset(1, 0).Range("A1") = Trim(ActiveCell.Offset(1, 0).Range("A1").Text)
ActiveCell.Offset(2, -1).Range("A1").Select
'P/O NOを削除
For i = 1 To 5
ActiveCell.Offset(0, 0).Range("A1").Select
If Selection = "･P/O NO" Or Selection <> "" Then
ActiveCell.Offset(0, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
End If
Next i
ActiveCell.Offset(0, 1).Range("A1").Select
Next j
'インチ数を整形する
Range("N12").Select
Selection = Replace(Selection, """", "")
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
OtherChar:=" ", FieldInfo:=Array(Array(1, 2), Array(2, 2)), TrailingMinusNumbers:=True
For i = 0 To 4
Range("N" & 12 + (i * 5)) = Selection
ActiveCell.Offset(0, 1).Range("A1").Select
Next i
Range("O12:S12").ClearContents
End Sub
Sub Macro2_1_4_paste()
'
' Macro2_1_4_paste Macro
' 帳票タイプ：no.4 - TOPPAN INC - TES
' Macro2_1_4_fomatingにて整形したデータをPL.xlsxへ貼付する
'
Dim hinmeiCount As String
Dim dataList() As Variant
Dim hinmei() As Variant: hinmei = Array()
Dim suuryo() As Variant: suuryo = Array()
Dim kingaku() As Variant: kingaku = Array()
Dim partNo() As Variant: partNo = Array()
Range("L12:O102").Select
Selection.Copy
Windows("PL.xlsx").Activate
Sheets("IV(NG)").Select
Range("N37:O92").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B38:B92").ClearContents
Range("B38:L92").Font.Bold = False
Range("C37:C92").NumberFormatLocal = "G/標準"
Range("N37:O92").NumberFormatLocal = "G/標準"
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("N37:N92"), "*品名*")
'1
Range("B37") = "=CONCATENATE(P37,"""""" Cu Film Sensor For Touch Panels"")"
Range("B38") = "=O37"
Range("B39") = "=CONCATENATE(""Part No:"",O40)"
Range("G39") = "=O38"
Range("I39:J39") = "=O39"
Range("B40") = "NO COMMERCIAL VALUE"
Range("B40").Select
Range("B40").Font.Bold = True
ActiveCell.Offset(2, 0).Range("A1").Select
'2~9
For i = 2 To hinmeiCount
dataList = Range("N37:O92").value
If i = 2 Then
hinmei = WorksheetFunction.index(dataList, 6, 0) '品名
suuryo = WorksheetFunction.index(dataList, 7, 0) '数量
kingaku = WorksheetFunction.index(dataList, 8, 0) '金額
partNo = WorksheetFunction.index(dataList, 9, 0) 'PartNo
ElseIf i = 3 Then
hinmei = WorksheetFunction.index(dataList, 11, 0) '品名
suuryo = WorksheetFunction.index(dataList, 12, 0) '数量
kingaku = WorksheetFunction.index(dataList, 13, 0) '金額
partNo = WorksheetFunction.index(dataList, 14, 0) 'PartNo
ElseIf i = 4 Then
hinmei = WorksheetFunction.index(dataList, 16, 0) '品名
suuryo = WorksheetFunction.index(dataList, 17, 0) '数量
kingaku = WorksheetFunction.index(dataList, 18, 0) '金額
partNo = WorksheetFunction.index(dataList, 19, 0) 'PartNo
ElseIf i = 5 Then
hinmei = WorksheetFunction.index(dataList, 21, 0) '品名
suuryo = WorksheetFunction.index(dataList, 22, 0) '数量
kingaku = WorksheetFunction.index(dataList, 23, 0) '金額
partNo = WorksheetFunction.index(dataList, 24, 0) 'PartNo
ElseIf i = 6 Then
hinmei = WorksheetFunction.index(dataList, 26, 0) '品名
suuryo = WorksheetFunction.index(dataList, 27, 0) '数量
kingaku = WorksheetFunction.index(dataList, 28, 0) '金額
partNo = WorksheetFunction.index(dataList, 29, 0) 'PartNo
ElseIf i = 7 Then
hinmei = WorksheetFunction.index(dataList, 31, 0) '品名
suuryo = WorksheetFunction.index(dataList, 32, 0) '数量
kingaku = WorksheetFunction.index(dataList, 33, 0) '金額
partNo = WorksheetFunction.index(dataList, 34, 0) 'PartNo
ElseIf i = 7 Then
hinmei = WorksheetFunction.index(dataList, 36, 0) '品名
suuryo = WorksheetFunction.index(dataList, 37, 0) '数量
kingaku = WorksheetFunction.index(dataList, 38, 0) '金額
partNo = WorksheetFunction.index(dataList, 39, 0) 'PartNo
ElseIf i = 8 Then
hinmei = WorksheetFunction.index(dataList, 41, 0) '品名
suuryo = WorksheetFunction.index(dataList, 42, 0) '数量
kingaku = WorksheetFunction.index(dataList, 43, 0) '金額
partNo = WorksheetFunction.index(dataList, 44, 0) 'PartNo
ElseIf i = 9 Then
hinmei = WorksheetFunction.index(dataList, 46, 0) '品名
suuryo = WorksheetFunction.index(dataList, 47, 0) '数量
kingaku = WorksheetFunction.index(dataList, 48, 0) '金額
partNo = WorksheetFunction.index(dataList, 49, 0) 'PartNo
End If
Selection = "=CONCATENATE(" & "P" & 37 + (5 * i - 5) & ","""""" Cu Film Sensor For Touch Panels"")"
ActiveCell.Offset(1, 0).Range("A1") = hinmei(2) '品名
ActiveCell.Offset(2, 0).Range("A1") = "=CONCATENATE(""Part No:"",""" & partNo(2) & """)" 'PartNo
ActiveCell.Offset(2, 5).Range("A1") = suuryo(2) '数量
ActiveCell.Offset(2, 7).Range("A1:B1") = kingaku(2) '金額
ActiveCell.Offset(3, 0).Range("A1") = "NO COMMERCIAL VALUE"
ActiveCell.Offset(3, 0).Range("A1").Font.Bold = True
ActiveCell.Offset(6, 0).Range("A1").Select
Next i
With Range("G37:G92") '2023/3/14 delete I37:J92, mod "#,###"
.NumberFormatLocal = "#,###"
.value = .value
End With
With Range("I37:J92")
.NumberFormatLocal = """US$""#,##0.00;[赤]-""US$""#,##0.00"
.value = .value
End With
End Sub
Sub Macro2_1_5_formating()
'
' Macro2_1_5_formating Macro
' 帳票タイプ：no.5 - VTS-Touchsensor Co., Ltd. - VIA
' 貼り付けたメール本文で不要な項目を削除する
'
Dim hinmeiCount As String
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("L12:L102"), "*品名*")
'1
Range("L12").Select
Selection.Characters(1, 1).Delete
Selection = Replace(Selection.Range("A1"), ChrW(160), "")
Selection = Trim(Selection.Text)
Range("M14") = Replace(Range("M14"), "pcs(良品数)", "") '数量
Range("M15") = Replace(Range("M15"), "円", "") '金額
Range("L16:M16").Select '通関申請用金額
Selection.Delete Shift:=xlUp
'P/O NOを削除
For i = 1 To 5
ActiveCell.Offset(0, 0).Range("A1").Select
If Selection = "PO:" Then
ActiveCell.Offset(0, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
Else
Exit For
End If
Next i
'通関申請用金額 ~ 'P/Nまでのブランク行を削除
For j = 1 To 5
Range("L15").Select
If Selection = "金額：" And ActiveCell.Offset(1, 0).Range("A1") = "" Then
ActiveCell.Offset(1, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
Else
Exit For
End If
Next j
'余分なブランク行を削除する
If ActiveCell.Offset(3, 0).Range("A1") = "" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Delete Shift:=xlUp
End If
ActiveCell.Offset(3, 0).Range("A1").Select
'2~9
For c = 2 To hinmeiCount
Selection.Characters(1, 1).Delete
Selection = Replace(Selection.Range("A1"), ChrW(160), "")
Selection = Trim(Selection.Text)
ActiveCell.Offset(2, 1).Range("A1") = Replace(ActiveCell.Offset(2, 1).Range("A1"), "pcs(良品数)", "") '数量
ActiveCell.Offset(3, 1).Range("A1") = Replace(ActiveCell.Offset(3, 1).Range("A1"), "円", "") '金額
ActiveCell.Offset(4, 0).Range("A1:B1").Select '通関申請用金額
Selection.Delete Shift:=xlUp
'P/O NOを削除
For i = 1 To 5
ActiveCell.Offset(0, 0).Range("A1").Select
If Selection = "PO:" Then
ActiveCell.Offset(0, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
Else
Exit For
End If
Next i
'通関申請用金額 ~ 'P/Nまでのブランク行を削除
For j = 1 To 5
ActiveCell.Offset(-1, 0).Range("A1").Select
If Selection = "金額：" And ActiveCell.Offset(1, 0).Range("A1") = "" Then
ActiveCell.Offset(1, 0).Range("A1:B1").Select
Selection.Delete Shift:=xlUp
Else
Exit For
End If
Next j
'余分なブランク行を削除する
If ActiveCell.Offset(3, 0).Range("A1") = "" Then
ActiveCell.Offset(3, 0).Range("A1:B1").Delete Shift:=xlUp
End If
ActiveCell.Offset(3, 0).Range("A1").Select
Next c
End Sub
Sub Macro2_1_5_paste()
'
' Macro2_1_5_paste Macro
' 帳票タイプ：no.5 - VTS-Touchsensor Co., Ltd. - VIA
' Macro2_1_5_fomatingにて整形したデータをPL.xlsxへ貼付する
'
Dim hinmeiCount As String
'NG計算用
Dim hinmeiData As String
Dim hinmeiRow As String
Dim hinmeiEndRow As String
Dim quantityData As String
Dim quantitySum As String
Dim dataList() As Variant
Dim description() As Variant: description = Array()
Dim hinmei() As Variant: hinmei = Array()
Dim suuryo() As Variant: suuryo = Array()
Dim kingaku() As Variant: kingaku = Array()
Dim partNo() As Variant: partNo = Array()
Range("L12:M102").Select
Selection.Copy
Windows("PL.xlsx").Activate
Sheets("IV(NG)").Select
Range("N37:O92").Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("B38:B92").ClearContents
Range("B38:L92").Font.Bold = False
Range("C37:C92").NumberFormatLocal = "G/標準"
Range("N37:O92").NumberFormatLocal = "G/標準"
'DISCRIPTIONをカウント
hinmeiCount = WorksheetFunction.CountIf(Range("N37:N92"), "*品名*")
'1
Range("B37") = "1"
Range("C37") = "=N37"
Range("C38") = "=O38" '品名
Range("C39") = "=CONCATENATE(""PART NO:"",O41)" 'P/N
'NGの合計数を取得
hinmeiData = Trim(Range("O38"))
quantityData = Range("O39")
Sheets("PL").Select
hinmeiRow = Range("B35:B92").Find(hinmeiData).row
hinmeiEndRow = Range("P" & hinmeiRow).End(xlDown).Offset(-1, 0).row
quantitySum = Application.WorksheetFunction.Sum(Range("S" & hinmeiRow & ":S" & hinmeiEndRow))
Sheets("IV(NG)").Select
Range("G39") = quantitySum
' Range("H39") = "PCS"
Range("I39:J39") = "=O40"
Range("L39") = quantitySum * Range("I39")
Range("B39").Select
'2~9
For i = 2 To hinmeiCount
ActiveCell.Offset(3, 0).Range("A1").Select
Selection = i
dataList = Range("N37:O92").value
If i = 2 Then
description = WorksheetFunction.index(dataList, 7, 0)
hinmei = WorksheetFunction.index(dataList, 8, 0) '品名
suuryo = WorksheetFunction.index(dataList, 9, 0) '数量
kingaku = WorksheetFunction.index(dataList, 10, 0) '金額
partNo = WorksheetFunction.index(dataList, 11, 0) 'PartNo
ElseIf i = 3 Then
description = WorksheetFunction.index(dataList, 13, 0)
hinmei = WorksheetFunction.index(dataList, 14, 0) '品名
suuryo = WorksheetFunction.index(dataList, 15, 0) '数量
kingaku = WorksheetFunction.index(dataList, 16, 0) '金額
partNo = WorksheetFunction.index(dataList, 17, 0) 'PartNo
ElseIf i = 4 Then
description = WorksheetFunction.index(dataList, 19, 0)
hinmei = WorksheetFunction.index(dataList, 20, 0) '品名
suuryo = WorksheetFunction.index(dataList, 21, 0) '数量
kingaku = WorksheetFunction.index(dataList, 22, 0) '金額
partNo = WorksheetFunction.index(dataList, 23, 0) 'PartNo
ElseIf i = 5 Then
description = WorksheetFunction.index(dataList, 25, 0)
hinmei = WorksheetFunction.index(dataList, 26, 0) '品名
suuryo = WorksheetFunction.index(dataList, 27, 0) '数量
kingaku = WorksheetFunction.index(dataList, 28, 0) '金額
partNo = WorksheetFunction.index(dataList, 29, 0) 'PartNo
ElseIf i = 6 Then
description = WorksheetFunction.index(dataList, 31, 0)
hinmei = WorksheetFunction.index(dataList, 32, 0) '品名
suuryo = WorksheetFunction.index(dataList, 33, 0) '数量
kingaku = WorksheetFunction.index(dataList, 34, 0) '金額
partNo = WorksheetFunction.index(dataList, 35, 0) 'PartNo
ElseIf i = 7 Then
description = WorksheetFunction.index(dataList, 37, 0)
hinmei = WorksheetFunction.index(dataList, 38, 0) '品名
suuryo = WorksheetFunction.index(dataList, 39, 0) '数量
kingaku = WorksheetFunction.index(dataList, 40, 0) '金額
partNo = WorksheetFunction.index(dataList, 41, 0) 'PartNo
ElseIf i = 8 Then
description = WorksheetFunction.index(dataList, 43, 0)
hinmei = WorksheetFunction.index(dataList, 44, 0) '品名
suuryo = WorksheetFunction.index(dataList, 45, 0) '数量
kingaku = WorksheetFunction.index(dataList, 46, 0) '金額
partNo = WorksheetFunction.index(dataList, 47, 0) 'PartNo
ElseIf i = 9 Then
description = WorksheetFunction.index(dataList, 49, 0)
hinmei = WorksheetFunction.index(dataList, 50, 0) '品名
suuryo = WorksheetFunction.index(dataList, 51, 0) '数量
kingaku = WorksheetFunction.index(dataList, 52, 0) '金額
partNo = WorksheetFunction.index(dataList, 53, 0) 'PartNo
End If
ActiveCell.Offset(0, 1).Range("A1") = description(1)
ActiveCell.Offset(1, 1).Range("A1") = hinmei(2) '品名
ActiveCell.Offset(2, 1).Range("A1") = "=CONCATENATE(""PART NO:"",""" & partNo(2) & """)" 'PartNo
hinmeiData = Trim(hinmei(2))
quantityData = suuryo(2)
Sheets("PL").Select
hinmeiRow = Range("B35:B92").Find(hinmeiData).row
hinmeiEndRow = Range("B" & hinmeiRow).End(xlDown).Offset(-1, 0).row
quantitySum = Application.WorksheetFunction.Sum(Range("S" & hinmeiRow & ":S" & hinmeiEndRow))
Sheets("IV(NG)").Select
ActiveCell.Offset(2, 5).Range("A1") = quantitySum '数量
' ActiveCell.Offset(2, 6).Range("A1") = "PCS" '数量Unit
ActiveCell.Offset(2, 7).Range("A1:B1") = kingaku(2) '金額
' ActiveCell.Offset(2, 10).Range("A1") = quantitySum * kingaku(2) '合計額
ActiveCell.Offset(2, 0).Range("A1").Select
Next i
With Range("I37:J92")
.NumberFormatLocal = "G/標準"
.value = .value
End With
With Range("G37:G92") '2023/3/15 add
.NumberFormatLocal = "#,###"
.value = .value
End With
With Range("I37:J92")
.NumberFormatLocal = """JPY""#,##0;[赤]-""JPY""#,##0"
.value = .value
End With
End Sub
Sub Macro2_2()
'
' Macro2_2 Macro
' 関数表記での編集後ファイルをIV(NG).xlsxとして保存
'
Dim thisPath As String
thisPath = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=thisPath & "\IV(NG).xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub Macro2_3()
'
' Macro2_3 Macro
' IV(NG)シートのブランク行を削除するマクロ <2021/09/06修正>
'
Dim r As String
Windows("IV(NG).xlsx").Activate
Sheets("IV(NG)").Select
Range("B36:J92").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Columns("M:Z").Select
Selection.Delete Shift:=xlToLeft
Range("B36").Select
If Sheet1.ReportTypeComboBox.Text = "no.1 - TOPPAN INC - Henghao" Then
If Range("B43") = 2 And Range("C43") = "" Then
Rows("43:91").Delete Shift:=xlUp
End If
If Range("B49") = 3 And Range("C49") = "" Then
Rows("49:91").Delete Shift:=xlUp
End If
If Range("B55") = 4 And Range("C55") = "" Then
Rows("55:91").Delete Shift:=xlUp
End If
If Range("B61") = 5 And Range("C61") = "" Then
Rows("61:91").Delete Shift:=xlUp
End If
If Range("B67") = 6 And Range("C67") = "" Then
Rows("67:91").Delete Shift:=xlUp
End If
If Range("B73") = 7 And Range("C73") = "" Then
Rows("73:91").Delete Shift:=xlUp
End If
If Range("B79") = 8 And Range("C79") = "" Then
Rows("79:91").Delete Shift:=xlUp
End If
If Range("B85") = "9" And Range("C85") = "" Then
Rows("85:91").Delete Shift:=xlUp
End If
ElseIf Sheet1.ReportTypeComboBox.Text = "no.4 - TOPPAN INC - TES" Then
r = Range("B91").row
Do While (38 <= r)
If Cells(r, 2).value = "" And Cells(r + 1, 2).value = "" Then
Rows(r & ":" & r).Delete Shift:=xlUp
End If
r = r - 1
Loop
ElseIf Sheet1.ReportTypeComboBox.Text = "no.2 - VTS-Touchsensor Co., Ltd. - Mutto" Or Sheet1.ReportTypeComboBox.Text = "no.5 - VTS-Touchsensor Co., Ltd. - VIA" Then
r = Range("C91").row
Do While (38 <= r)
If Cells(r, 3).value = "" And Cells(r + 1, 3).value = "" Then
Rows(r & ":" & r).Delete Shift:=xlUp
End If
r = r - 1
Loop
Else
r = Range("C91").row
Do While (38 <= r)
If Cells(r, 3).value = "" Then
Rows(r & ":" & r).Delete Shift:=xlUp
End If
r = r - 1
Loop
End If
End Sub
Sub Macro2_4()
'
' Macro2_4 Macro
' IVシート編集用ファイルとしてIV(NG)_PL.xlsx 名で保存
'
Dim thisPath As String
thisPath = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=thisPath & "\IV(NG)_PL.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("ToppanVTS書類作成マクロv1.8.xlsm").Activate
Sheets("Sheet1").Select
Range("L12:O83").ClearContents
Range("A1").Select
End Sub
```
Google Drive
Gist
Clipboard
Sign in with Wallet
