品名が変わる所で空白行がある表で在庫数を品名単位で計算したい (1/5) - Office系ソフト - 教えて！goo

> ・データ元を別の値に変換してから転記できるならこっちも
> 　そうしてよ
> と言われてしまいました。

さすがにこれだけじゃ何がしたいのかぜんぜんわかりませ～ん。
さて、今夜もお座敷が待っているのです。
では、さらばガンダム少年。

通報する

おはよう、gx9wxさん。
昨夜はお座敷の時間が迫っていて説明できませんでしたが、TEST03とTEST02　の違いはもうおわかりですね？

> G1→G2
> C1→C2
> にしたのですがERRになりました。
> 「書式が相違して貼付できません」

「書式」じゃなく、「コピー領域と張り付け領域の形が違うため」とでたんでしょ？
多分、素直でかわいいgx9wxさんは、ご丁寧に
.Columns("G:G").Copy
.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
の部分まで、G2に直したんじゃないのかな？
そうだとすれば、エラーの理由は簡単です。
コピーしたのがG列の全部（65536行）なのに、張り付け先はG2以降の65535行になっちゃうので「形が違うぞぉ!ヾ(￣□￣； )ノ！」とエクセルに叱られわけです。
1行目が項目行なら、ここは数式じゃなく文字列ですよね？
ならば、ここは
.Columns("G:G").Copy
.Range("G1").PasteSpecial Paste:=xlPasteValues
のままで何の問題もなかったわけです。

以上、蛇足ですがご参考のため。

通報する

おや、2行目からでしたか。

では、

Sub TEST03()
　　With Sheets("Sheet2")
　　　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　　　.Range("G2").Formula = _
　　　　"=IF(ISNA(VLOOKUP(C2,Sheet3!$A:$B,2,FALSE)),""不明"",VLOOKUP(C2,Sheet3!$A:$B,2,FALSE))" '数式入力
　　　　.Range("G2").Copy .Range("G2:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　　　.Columns("G:G").Copy
　　　　.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
　　　　Application.CutCopyMode = False
　　End With
End Sub

それでは、夜の町へ今夜もご出勤！
行ってまいります。

通報する

> これだとやばくてＨＩＴしない場合は空白で行きたいです。
> もしくは「不明」という文字を転記（代入？）させる事は可能でしょうか？

そうですか、ヤバいですか。
では、これでいかがでしょう？

Sub TEST02()
　　With Sheets("Sheet2")
　　　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　　　.Range("G1").Formula = _
　　　　"=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),""不明"",VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))" '数式入力
　　　　.Range("G1").Copy .Range("G1:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　　　.Columns("G:G").Copy
　　　　.Range("G1").PasteSpecial Paste:=xlPasteValues 'G列を値に変換
　　　　Application.CutCopyMode = False
　　End With
End Sub

空白にしたい場合は、""不明""　を　""""　にしてください。

> もしかして私のＰＣを覗いているのかなと思う時あります。

あはは、それが出来たらほんと回答が楽なんですけどねえ。
せめて画像だけではなく、ファイルもアップできればいいのですが・・・。

通報する

> シート２のＣ列の値を検索値としてシート３のＡ列をVLOOKUPで検索し
> ＨＩＴしたらシート３の該当行のＢ列の値をシート２のＧ列に転記し

ヒットしないときはC列の値をそのまま表示でしたよね？
ということは、ワークシート関数式でSheet2のG1セルなら
=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),C1,VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))
という式が入ればいいのですね？（もちろん最後は式ではなく値に変換しますが）

ならば前回と同じようにしたいなら

Sub TEST01()
　　With Sheets("Sheet2")
　　.Columns("G:G").NumberFormatLocal = "G/標準" 'G列の書式を標準に
　　.Range("G1").Formula = _
　　"=IF(ISNA(VLOOKUP(C1,Sheet3!$A:$B,2,FALSE)),C1,VLOOKUP(C1,Sheet3!$A:$B,2,FALSE))" '数式入力
　　.Range("G1").Copy .Range("G1:G" & .Range("C" & .Rows.Count).End(xlUp).Row) 'データ最終行までコピー
　　.Columns("G:G").Copy 'G列を値に変換
　　.Range("G1").PasteSpecial Paste:=xlPasteValues
　　Application.CutCopyMode = False
　　End With
End Sub

> ファイル名を変更されてもメンテしなくていいように

同じBOOK内ですから、式の中にファイル名は存在しません。
だから名前を変えられても無関係です。

> それはmerlionXXさんと私にしかわかりませんのでm(__)m）

ん？二人だけの秘密？（笑）
それって、ファイル名変更に対応したということ？
それとも何か別にありましたっけ？

通報する

さて、さきほどの回答をご覧いただいてもうお分かりとは思いますが、この際ですから（笑）簡単に説明すると
With Sheets("集計") '(1)　は、最後のEnd With '(1)と対になっているわけですから全部にかかっていますよね。
つまり、その下の
With .Range("A1") '(2)　
With .Range("A2:O2") '(3)
With .PageSetup '(4)
のドットの前は
たとえば、With Sheets("集計").Range("A1") '(2)　のようにSheets("集計") が略されているわけです。
そして、(2)から(4)のWith~End Withのなかではドットの前に
それぞれ、
Sheets("集計").Range("A1")
Sheets("集計").Range("A2:O2")
Sheets("集計").PageSetup
が略されています。

ですから、ご希望のところで二つにわけるには以下のようになります。

Sub ページ設定前編()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　With .UsedRange.Borders 'データ部分を罫線で囲む
　　　　　　.LineStyle = xlContinuous
　　　　　　.Weight = xlThin
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。・・
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　End With
　　ActiveWindow.Zoom = 75 '画面表示を75%に
End Sub 'ここで分割（別プロシージャーに）

Sub ページ設定後編()
　　With Sheets("集計")
　　　　With .PageSetup '印刷用ページ設定
　　　　　　.PrintTitleRows = "$1:$2"
　　　　　　.CenterFooter = "&P / &N ページ"
　　　　　　.LeftMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.RightMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.TopMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.BottomMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.HeaderMargin = Application.InchesToPoints(0.511811023622047)
　　　　　　.FooterMargin = Application.InchesToPoints(0.196850393700787)
　　　　　　.CenterHorizontally = True '水平方向の中央寄せ
　　　　　　.Orientation = xlPortrait '縦向き
　　　　　　.PaperSize = xlPaperA4 'A4にあわせて
　　　　　　.Zoom = False '自動
　　　　　　.FitToPagesWide = 1 '横を１ページ内に
　　　　　　.FitToPagesTall = False '縦方向は制限なし
　　　　End With
　　End With
End Sub

これでほんとの完了かな？

通報する

こんにちはガンダムさん。

> 今回教えていただいた記述でも
> WithとEnd　Withだけにすると
> 以下の順番ですがどうしてこうなのか自分で理解ができません。

どのWithとEnd Withがセットなのか、同じ番号を振りました。
よく見てください。

Sub ページ設定02()

　　With Sheets("集計") '(1)

　　　　With .Range("A1") '(2)

　　　　End With '(2)

　　　　With .Range("A2:O2") '(3)

　　　　End With '(3)

　　　　With .PageSetup '(4)

　　　　End With '(4)

　　End With '(1)

End Sub

通報する

おはようございます、ガンダムさん。
Sub test07() '2000-2003共用
うまくいってよかった！

今日も東京は快晴です。
GX9901ってなんだろうとおもったら・・・・・・。
gx9wxさんは、幼少期はSFアニメ大好き少年だったのかな。
わたしもカラオケでは「科学忍者隊ガチャマンの歌」好きです。
ヾ(=^▽^=)ノ

さて、本日の日課（？）

ページ設定のコード、不要部分と思われるものを削ったり、少しいじってみました。
Zoomはプリンターに影響を受けるので、決めうちではなく横を１ページにおさめるようにしてみました。

Sub ページ設定02()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。・・
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　　　With .PageSetup '印刷用ページ設定
　　　　　　.PrintTitleRows = "$1:$2"
　　　　　　.CenterFooter = "&P / &N ページ"
　　　　　　.LeftMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.RightMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.TopMargin = Application.InchesToPoints(0.78740157480315)
　　　　　　.BottomMargin = Application.InchesToPoints(0.393700787401575)
　　　　　　.HeaderMargin = Application.InchesToPoints(0.511811023622047)
　　　　　　.FooterMargin = Application.InchesToPoints(0.196850393700787)
　　　　　　.CenterHorizontally = True '水平方向の中央寄せ
　　　　　　.Orientation = xlPortrait '縦向き
　　　　　　.PaperSize = xlPaperA4 'A4にあわせて
　　　　　　.Zoom = False '自動
　　　　　　.FitToPagesWide = 1 '横を１ページ内に
　　　　　　.FitToPagesTall = False '縦方向は制限なし
　　　　End With
　　End With
End Sub

通報する

ごめん、わたしのミスです。
わたしが2000で試せるように修正したときに記述を誤りました。
(///▽///)　赤面

これなら大丈夫だと思います。

Sub test07() '2000-2003共用
　　Dim myRng As Range
　　Dim x As Long, y As Long, z As Long, n As Long, i As Long
　　Dim myAr, myNm()
　　With Sheets("集計")
　　　　Set myRng = .Range(.Range("H1"), .Range("H1").End(xlDown)) 'H列データ
　　　　x = .Range("A1").SpecialCells(xlLastCell).Column + 1 'シート使用範囲の一つ右の列番号
　　　　y = x - myRng.Column 'H列と上記の列の差
　　　　Application.ScreenUpdating = False '画面更新停止
　　　　.Cells(1, x).Value = 1 'x番目列の１行目セルに1を入力
　　　　With myRng.Offset(1, y).Resize(myRng.Count - 1, 1) 'その下に数式入力
　　　　　　.FormulaR1C1 = "=R[-1]C+1+(R[-1]C[-" & y & "]<>RC[-" & y & "])" '連番(+1)設定（区切位置では+2）
　　　　　　.Copy 'コピー
　　　　　　.PasteSpecial Paste:=xlPasteValues '値張り付け（数式を値にした）
　　　　　　Application.CutCopyMode = False
　　　　　　myAr = .Offset(-1).Resize(.Count + 1, 1).Value '配列myArに値を代入（Offsetをもどして）
　　　　　　For i = LBound(myAr, 1) To UBound(myAr, 1) - 1 '配列内で
　　　　　　　　If myAr(i + 1, 1) - myAr(i, 1) = 2 Then '差が2の場合
　　　　　　　　　　ReDim Preserve myNm(n) '配列添字追加
　　　　　　　　　　myNm(n) = myAr(i, 1) + 1 '配列myNmに+1の値を代入
　　　　　　　　　　n = n + 1 'カウント
　　　　　　　　End If
　　　　　　Next i '繰り返し
　　　　　　.Cells(.Count).Offset(1).Resize(UBound(myNm) + 1, 1).Value = Application.Transpose(myNm) '連番の下に配列myNmを入力
　　　　End With
　　　　.Range(.Cells(1), .Cells(1, x).End(xlDown)).Sort Key1:=.Cells(1, x), Order1:=xlAscending, Header:=xlNo 'x番目列基準で昇順に並び替え
　　　　.Columns(x).Clear 'x番目列の内容削除
　　　　z = .Range("H" & .Rows.Count).End(xlUp).Row 'H列最終行取得
　　　　Application.ScreenUpdating = True '画面更新停止解除
　　　　ActiveWorkbook.Names.Add Name:="ExternalData_1", RefersTo:="=" & .Name & "!" & .Range(.Cells(1, "A"), .Cells(z, x - 1)).Address'ExternalData_1拡大
　　End With
End Sub

あしたは定休日ですか。
ゆっくりおやすみください。

通報する

こんにちは。(^o^)/

投稿日時 - 2010-11-04 13:52:32のお礼を見逃してました。
Sub 名前変換03()はうまくいったようですね。
Sub test06() も思ったようになってくれたらよいのですが会社の2000では試せません。

さて、以前の

> もうこのさいですので聞いてしまいます。

が、まだいくつか残ってましたね。

並べ替えは違うでしょうが、その他の作業は、もしこれらの作業を続けてやっているなら、以下ようにしたほうがすっきりすると思います。

Sub このさい聞いちゃった()
　　With Sheets("集計")
　　　　.Range("A:O").EntireColumn.AutoFit '項目名行の幅をオートフィット
　　　　.Range("A:K").HorizontalAlignment = xlCenter '各列の値を中央に
　　　　.Rows(1).Insert Shift:=xlDown　'1行目にタイトル用の空白行を作成する。
　　　　With .Range("A1") '表のタイトルをつける
　　　　　　.Value = "実績一覧表" & Format(Date, "yyyy/mm/dd")
　　　　　　.HorizontalAlignment = xlLeft
　　　　　　.VerticalAlignment = xlCenter
　　　　End With
　　　　With .Range("A2:O2")
　　　　　　.HorizontalAlignment = xlCenter '項目名行をセルの中央へ
　　　　　　.Interior.ColorIndex = 15 '項目欄を灰色で塗る
　　　　End With
　　End With
End Sub

・作業の対象を明示する。
・やむを得ない場合以外はSelectしない。
・まとめられるものはまとめて書く。
これらが基本じゃないかなと思います。

わたしもこの際、聞いちゃおうかな。
gx9wxさんのID、gx9wxってどんな意味なんでしょう？

通報する