Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8541 / 76732

←次へ　｜　前へ→


	【73761】表の比較

ｔ－ｋ - 13/2/10(日) 15:38 -


	引用なし

	パスワード

素人なのでわかりやすく教えてください

シート１とシート２の比較をしたいです

基本シート１のデータに変更したい
シート１のデータは毎日更新されます

シート１　1　　　２　　３　　　　　4
　　　　品番　　品名　　1/1　　　1/2　←日にち行

Ａ　　****　　　****　　100　　　　300

Ｂ　　****　　　****

Ｃ　　****　　　****

シート　２
基本はシート１と同じ形　数量をシート２とシート１の品番と日が同じなら数量を転記
品番はシート２にない場合あり
ない場合シート１の品番のところに色を塗る処理をしたい

＊シート２はデータを蓄積したいため　関数でのしょりではなく
値のみ入力したい

シート１に加工処理してデータを落とすまでできました(下記プログラム)
それ以降をどうしたらいいかわかりません
　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

よろしくご指導お願いします。

497 hits

▼

【73761】表の比較 ｔ－ｋ 13/2/10(日) 15:38

≪