[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件があった時に、行の挿入削除』（A）
前期と今期の売上比較を作成中です。
AとCに名前、BとDに前期今期の売上額が入っております。
しかし、前期であった会社が今期ではなくなったり、今期新規にとった会社があったりします。
今までは、=exactでAとCを比較して、FALSEになればAやCに行を足したり消したりしておりました。
この作業を、もっと簡単にすることは可能なのでしょうか。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
どんなときに、どこに行を足すのか、どこを消す（削除？）のか
具体例を挙げていただけますか。
（マナ） 2019/04/02(火) 16:12
A B C D
?@あいう 123 あいう 456
?Aえおか 123 えおか 0
?Bきくけ 123 きくけ 456
?Cこさし 123 こさし 0
?Dすせそ 0 すせそ 456
こういう感じです。
（A） 2019/04/03(水) 09:26
Dim c As Range, i As Long
Sheets("Sheet2").Cells.Clear
For Each c In Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 4)
If c.Column = 1 Or c.Column = 3 Then
If Sheets("Sheet2").Range("A:A").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("A" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("A:A").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("B" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("B" & i + 1).Value = Sheets("Sheet1").Range("A:A").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
Sheets("Sheet2").Range("C" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("C:C").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("D" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("D" & i + 1).Value = Sheets("Sheet1").Range("C:C").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
i = i + 1
End If
End If
Next c
End Sub
（mm） 2019/04/03(水) 11:00
訂正があります。
A＝コード?ａ@ B＝お客様名 C＝金額
試してみたのですが、空行が追加された場所が0になります。
0ではなく、お客様名を引っ張ることは可能でしょうか。
（A） 2019/04/03(水) 11:10
Dim c As Range, i As Long
Sheets("Sheet2").Cells.Clear
For Each c In Sheets("Sheet1").Range("B1").CurrentRegion.Offset(, 1).Resize(, 4)
If c.Column = 2 Or c.Column = 4 Then
If Sheets("Sheet2").Range("B:B").Find(c.Value, , , xlWhole) Is Nothing Then
If c.Column = 2 Then Sheets("Sheet2").Range("A" & i + 1).Value = c.EntireRow.Cells(1).Value
Sheets("Sheet2").Range("B" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("B:B").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("C" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("C" & i + 1).Value = Sheets("Sheet1").Range("B:B").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
Sheets("Sheet2").Range("D" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("D:D").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("E" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("E" & i + 1).Value = Sheets("Sheet1").Range("D:D").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
i = i + 1
End If
End If
Next c
End Sub
（mm） 2019/04/03(水) 15:12
シート1
A B C D E F
10 あ 123 20 い 321
20 い 456 40 え 654
30 う 789 50 お 987
40 え 12 90 け 432
50 お 345 120 し 321
60 か 678 130 す 654
80 く 901 170 ち 876
90 け 234 180 つ 109
↓マクロ実行↓
A B C D E F
A B C B 0
D 0 D E 10 あ 123 あ 0 20 0 20 い 20 い 456 い 0 40 0 40 え 30 う 789 う 0 50 0 50 お 40 え 12 え 0 90 0 90 け 50 お 345 お 0 120 0 120 し 60 か 678 か 0 130 0 130 す 80 く 901 く 0 170 0 170 ち 90 け 234 け 0 180 0 180 つ
このようになります
（A） 2019/04/03(水) 15:48
Dim c As Range, i As Long
Sheets("Sheet2").Cells.Clear
For Each c In Sheets("Sheet1").Range("B:C,E:F").SpecialCells(2)
If c.Column = 2 Or c.Column = 5 Then
If Sheets("Sheet2").Range("B:B").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("A" & i + 1).Value = c.Offset(, -1).Value
Sheets("Sheet2").Range("B" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("B:B").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("C" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("C" & i + 1).Value = Sheets("Sheet1").Range("B:B").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
Sheets("Sheet2").Range("D" & i + 1).Value = c.Offset(, -1).Value
Sheets("Sheet2").Range("E" & i + 1).Value = c.Value
If Sheets("Sheet1").Range("E:E").Find(c.Value, , , xlWhole) Is Nothing Then
Sheets("Sheet2").Range("F" & i + 1).Value = 0
Else
Sheets("Sheet2").Range("F" & i + 1).Value = Sheets("Sheet1").Range("E:E").Find(c.Value, , , xlWhole).Offset(, 1).Value
End If
i = i + 1
End If
End If
Next c
End Sub
（mm） 2019/04/03(水) 17:09
Option Explicit
Sub test()
Dim dic As Object
Dim v
Dim i As Long
Dim s As String
Set dic = CreateObject("scripting.dictionary")
v = Cells(1).CurrentRegion.Value
For i = 1 To UBound(v)
s = v(i, 1)
If s <> "" Then
dic(s) = Array(v(i, 1), v(i, 2), v(i, 3), v(i, 1), v(i, 2), 0)
End If
Next
For i = 1 To UBound(v)
s = v(i, 4)
If s <> "" Then
If Not dic.exists(s) Then
dic(s) = Array(v(i, 4), v(i, 5), 0, v(i, 4), v(i, 5), v(i, 6))
Else
dic(s) = Array(v(i, 4), v(i, 5), dic(s)(2), v(i, 4), v(i, 5), v(i, 6))
End If
End If
Next
Worksheets.Add.Cells(1).Resize(dic.Count, 6).Value = Application.Index(dic.items, 0, 0)
End Sub
（マナ） 2019/04/04(木) 00:53
１）シート追加
２）シート1 のA、B列を１）のシートのA、B列にコピー
３）その下に、シート1 のD、E列をコピー
４）１）のシートのA、B列で「重複の削除」実行
５）１）のシートのA、B列をD、E列にコピー
６）１）のシートのC列にvlookup関数挿入し、前期売上計算
７）１）のシートのF列にvlookup関数挿入し、今期売上計算
（マナ） 2019/04/04(木) 01:27
請求先ｺｰﾄﾞ 請求先略称 0 請求先ｺｰﾄﾞ 請求先略称 純売上金額
10002 あ 0 10002 あ 0
10003 い 0 10003 い 0
10004 う 0 10004 う 0
10005 え 0 10005 え 0
10006 お 0 10006 お 0
10006 お 0 10006 お 26880
10228 か 0 10228 か 0
10229 き 0 10229 き 0
10229 き 0 10229 き 8887446
10232 く 0 10232 く 0
10233 け 0 10233 け 0
10234 こ 0 10234 こ 0
マナ様
マクロの内容は正直理解できません。
人員不足のため、ワンクリックでことが進めば楽なのにな、と思い質問背せていただいております。
マナ様の方も実行してみましたが、『型が一致しません』と出てしまいました。
（A） 2019/04/05(金) 09:25
どんな数式にしましたか。
（マナ） 2019/04/05(金) 18:20
これですが、
?@元データと昨年得意先比較（シート1と2）
→このときは式入力後も元データと合計があっています
?A昨年と今期比較（シート3と4）
→重複削除しても、さらに重複している？
シート3では合計金額があっており、そのままコピーしてシート4に張り付けているのですが、シート4で重複の削除をしても、同じ数字が残っているようです。
例
10111
10111
数字の前にスペースなどが入っているようなので、RIGHRで右から5文字取得でしております。
（A） 2019/04/08(月) 14:32
＞数字の前にスペースなどが入っているようなので
これについては、その後で。
（マナ） 2019/04/08(月) 18:32
mm様のものもうまく作動しないので使えておりません。
ですので、手作業しながらマクロ登録しました。
データ重複削除→並び替え EXACTでTRUE削除
を加えたらなんとかいけそうです。
並び替えの時は、並び替えの前にというものが出て、数値に見えるものはすべて数値として並び替えを行う、にしています。
（A） 2019/04/09(火) 10:00
マクロではなく、手作業のほうについて確認お願いします。
「重複の削除」やVlookupの計算は期待通りになるか教えてください。
A） 2019/04/03(水) 15:48 のデータでです。
実際のデータでだめなのはわかっています。
手順に誤解がないことを念のため確認したいのです。
（マナ） 2019/04/09(火) 18:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.