|
素人なのでわかりやすく教えてください
シート1とシート2の比較をしたいです
基本シート1のデータに変更したい
シート1のデータは毎日更新されます
シート1 1 2 3 4
品番 品名 1/1 1/2 ←日にち行
A **** **** 100 300
B **** ****
C **** ****
シート 2
基本はシート1と同じ形 数量をシート2とシート1の品番と日が同じなら数量を転記
品番はシート2にない場合あり
ない場合シート1の品番のところに色を塗る処理をしたい
*シート2はデータを蓄積したいため 関数でのしょりではなく
値のみ入力したい
シート1に加工処理してデータを落とすまでできました(下記プログラム)
それ以降をどうしたらいいかわかりません
Sub 開く()
Dim vri As Variant
Dim haifun
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Application.ScreenUpdating = False
vri = Application.GetOpenFilename( _
filefilter:="テキストファイル,*.xls,", _
Title:="他のファイルを開く", _
MultiSelect:=False)
If vri = False Then
MsgBox "ファイルが選択されませんでした。", _
vbOKOnly + vbExclamation, "ファイル名の入力チェック"
Else
Workbooks.Open (vri)
End If
ActiveSheet.Select
Rows("1").Select
ActiveCell.AutoFilter field:=4, _
Criteria1:="*****"
Range("A1").CurrentRegion.Select
Selection.Copy
Workbooks("試作").Activate
Worksheets("データ取込").Activate
Range("A1").Select
ActiveCell.PasteSpecial (xlPasteValues)
Range("A:E").Select
Selection.Delete
Range("A1").End(xlToRight).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Delete
Range("A1").CurrentRegion.Select
Cells.Find(What:="合計", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Activate
If ActiveCell = "合計" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Delete
Else
Range("A1").Activate
End If
For haifun = 1 To Range("A1").CurrentRegion.Rows.Count
Cells.Find(What:="-", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False).Activate
If ActiveCell = "-" Then
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Delete
Else
Range("A1").Activate
End If
Next haifun
Range("A2").EntireRow.Insert
Range("C2").Select
ActiveCell.FormulaR1C1 = "=LEN(R[-1])"
Set rng = Range("c2")
Set rng2 = Range("XEX1").End(xlToLeft).Offset(1)
Range("C2").AutoFill Destination:=Range(rng, rng2), Type:=xlFillDefault
Range("A3").EntireRow.Insert
Range("A3").EntireRow.Insert
Range("d3").Select
Range("D3").Select
Selection.FormulaR1C1 = "=IF(OR(R[-1]=1,R[-1]=2),R[-2]C[-1]+1,R[-2])"
Range("E3").Select
Selection.FormulaR1C1 = "=IF(OR(R[-1]=1,R[-1]=2),C[-1]+1,R[-2])"
Set rng3 = Range("E3")
Set rng4 = Range("XEX1").End(xlToLeft).Offset(2)
Range("e3").AutoFill Destination:=Range(rng3, rng4), Type:=xlFillDefault
Rows("3:3").Select
Selection.NumberFormatLocal = "yyyy/m/d;@"
Range("d3").Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Copy
Range("D4").PasteSpecial xlPasteValues
Range("D4").Select
Rows("4:4").Select
Selection.NumberFormatLocal = "yyyy/m/d;@"
Range("D4").Select
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
Selection.Copy
Range("D1").Select
Range("D1").PasteSpecial xlPasteValues
Rows("1:1").Select
Selection.NumberFormatLocal = "yyyy/m/d;@"
Rows("2:4").EntireRow.Delete
Rows("1:1").Select
Selection.NumberFormatLocal = "m/d;@"
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlRight
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:2").Select
Selection.Insert
Range("C2").Select
Range("c2").Formula = "=VALUE(C1)"
Range("C2").Select
Set rng = Range("c2")
Set rng2 = Range("XEX1").End(xlToLeft).Offset(1)
Range("C2").AutoFill Destination:=Range(rng, rng2), Type:=xlFillDefault
Range("C2").Select
Rows("3:3").Select
Selection.Insert
Range("C2").Select
Range("c2").Copy
Range("C3").PasteSpecial xlPasteValues
Range("C3").AutoFill Destination:=Range(Range("C3"), Range("xex1").End(xlToLeft).Offset(2)), Type:=xlFillDefault
Range("C3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("c1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Rows("2:3").Delete
Range(Range("C2"), Range("XEX1").End(xlToLeft).End(xlDown)).Select
Selection.NumberFormatLocal = "G/標準"
Application.ScreenUpdating = True
Worksheets("メニュー画面").Activate
MsgBox "データ取り込み終了"
End Sub
よろしくご指導お願いします。
|
|