Excel VBA質問箱 IV

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

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


8541 / 76732 ←次へ | 前へ→

【73761】表の比較
質問  t−k  - 13/2/10(日) 15:38 -

引用なし
パスワード
   素人なのでわかりやすく教えてください

シート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

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

【73761】表の比較 t−k 13/2/10(日) 15:38 質問
【73762】Re:表の比較 UO3 13/2/10(日) 19:22 発言
【73763】Re:表の比較 UO3 13/2/10(日) 19:51 発言
【73766】Re:表の比較 t−k 13/2/10(日) 22:56 発言
【73767】Re:表の比較 UO3 13/2/11(月) 6:46 発言
【75126】Re:表の比較 T-k 13/12/14(土) 0:02 質問
【75127】Re:表の比較 γ 13/12/14(土) 6:36 発言
【75133】Re:表の比較 T-k 13/12/17(火) 0:55 発言
【75134】Re:表の比較 γ 13/12/17(火) 6:35 発言
【75135】Re:表の比較 T-k 13/12/18(水) 0:28 発言
【75138】Re:表の比較 γ 13/12/18(水) 23:17 発言
【75141】Re:表の比較 T-k 13/12/20(金) 0:36 発言
【75143】Re:表の比較 γ 13/12/20(金) 7:16 発言
【75147】Re:表の比較 T-k 13/12/20(金) 23:50 お礼
【73768】Re:表の比較 UO3 13/2/11(月) 14:08 発言
【73770】Re:表の比較 t−k 13/2/12(火) 23:38 お礼
【73780】Re:表の比較 UO3 13/2/13(水) 19:30 発言
【81386】Re:表の比較 T-K 20/7/13(月) 23:33 質問[未読]
【81388】Re:表の比較 γ 20/7/14(火) 5:43 発言[未読]
【81393】Re:表の比較 T-K 20/7/14(火) 19:54 発言[未読]
【81394】Re:表の比較 γ 20/7/15(水) 9:15 回答[未読]
【81395】Re:表の比較 T-K 20/7/15(水) 17:45 お礼[未読]
【81396】Re:表の比較 マナ 20/7/15(水) 21:02 発言[未読]
【81398】Re:表の比較 マナ 20/7/15(水) 21:40 発言[未読]
【81397】Re:表の比較 マナ 20/7/15(水) 21:04 発言[未読]
【81399】Re:表の比較 T-K 20/7/15(水) 23:57 発言[未読]
【81400】Re:表の比較 マナ 20/7/16(木) 21:05 発言[未読]
【81410】Re:表の比較 T-K 20/7/23(木) 23:51 発言[未読]
【81412】Re:表の比較 マナ 20/7/24(金) 11:03 発言[未読]
【81415】Re:表の比較 マナ 20/7/24(金) 11:51 発言[未読]
【81429】Re:表の比較 T-K 20/7/29(水) 23:31 発言[未読]
【81433】Re:表の比較 マナ 20/7/30(木) 19:30 発言[未読]
【81434】Re:表の比較 マナ 20/7/30(木) 20:20 発言[未読]
【81435】Re:表の比較 T–K 20/8/1(土) 12:29 お礼[未読]

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