帳票の整理で困っています。
以下のようなデータがシート1に入力されています。
  A  B   C    D   E    F 
1名前 住所 請求書 納品書 領収書 到着確認書
2山田 東京  ○       ○
3井上 千葉      ○   ○    ○
4植田 大阪      ○   ○
5境  秋田  ○   ○
6大田 沖縄  ○   ○   ○    ○
7野原 埼玉          ○

データの”○”は書類が確認済で、空白は未確認あるいは未到着です。
"C"列から"F"列の中で1つ以上空白のあるデータを検索して別シート2へそのままコピー出来るマクロ、そしてシート2に表示されたデータで空白となっている"C"列から"F"列の項目名(請求書等)をシート3に用意してあるあいさつ文の書類名入力セル(ここではE10としておきます)に記入できるマクロがさっぱり分かりません。
データ件数は1000件以上になるかと思います。
どなたかお助けください。

このQ&Aに関連する最新のQ&A

A 回答 (4件)

ja7awuさん、Thanks



hirosatonn さん、
c.Resize(, 6).Copy
として、6列を取得していますから、「A列のみしかコピー」されない、というのは、コードを見る限りでは、初歩的なコードですから、そのようなことは考えられません。何か、私の書いたコードを変更されたか、A列の右隣-B列移行が、隠し列になっているか、などだと思います。
ただし、念のために、加筆してみました。

Sub FindBlank1()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..)は、1行目にあるとします。
With Sheet1
.Activate
i = 2 '2行目から
Set Rng = .Range("A1", .Range("A65536").End(xlUp))
For Each c In Rng
 If Application.CountA(c.Offset(, 2).Resize(, 4)) <> 4 Then
   'A列から、A列を含めて6列取得し、Sheet2にコピー
   c.Resize(, 6).Copy Sheet2.Cells(i, 1).Resize(, 6)
   i = i + 1
 End If
Next
End With
End Sub

Sub FildBlank2()
Dim Deliveries As Variant
Dim i As Long, j As Long
Dim DataRows As Long
Dim Result As String
'配列式に格納
Deliveries = Array("請求書", "納品書", "領収書", "到着確認書")
With Sheet2
'Sheet2 をオープン
.Activate
DataRows = Range("A2", Range("A65536").End(xlUp)).Rows.Count + 1
For i = 2 To DataRows '2行目から
 For j = 3 To 6 '3列目~6列目
 If .Cells(i, j).Value = "" Then '調べたセルの文字列0の長さだったら、
   '配列より、取り出す
   Result = Result & ";" & Deliveries(j - 3)
 End If
 Next j
 If Result <> "" Then
   '結果が空でないなら、H列に貼り付け
   .Cells(i, 7).Offset(, 1).Value = Mid(Result, 2)
   Result = ""
 End If
Next i
End With
End Sub

Sheet3 の"E10" に出すのは、関数などで行ってください。
つまり、"E10" に、全て出すということはありえませんから、INDEX 関数などを使って、Sheet2 から、引き出すのが良いと思います。

=INDEX(Sheet2!A2:H17,H1,8)

H1 に、数字を入れます。

現実の問題として、1000件以上ですから、この後に、印刷という作業が加わるものだと思います。しかし、[教えて!goo]では、書き込みの際の物理的な制約もありますので、専門のExcel のVBAの掲示板なりでお尋ねになるか、goomaniaさんの#2 の内容を参考にしてください。ここら辺が限界です。
    • good
    • 0
この回答へのお礼

色々とありがとうございました。そしてすみませんでした。コードをちょっといじっていました。
関数を使って頑張ってみます。

お礼日時:2005/04/19 21:21

> そしてA列のみしかコピーされません。



コードをそのままコピーして使いましたか?

括弧の中の , が落ちている可能性がありますよ。


後半の件は、山田さんの場合は、それでいいとしても、次の井上さんとかは、
どうするのですか?

1つでも○が無い人について挨拶文を差込印刷したい といことと違うのですか?

もうちょっと、解るように書きましょう。

横レス 失礼 !!
    • good
    • 0

質問者さんのVBAについてのご理解の程度がわかりませんが、ご自分でVBAプログラムをある程度作成できる実力がないと、この「教えてgoo」サイトで質問者さんのご希望をかなえるVBAプログラムを公開して欲しいというご要望になってしまいます。


ご質問の内容から推察すると、請求書・納品書・領収書の未発行先について、挨拶文とともに発送する事務を合理化するためのプログラムだと思いますが、これをそのまま公開することはプログラムも大きいと考えられますので基本的に無理があります。
最終的な目的が「EXCELのVBAマクロを使って請求書、納品書、領収書の発行を管理する」ことだとすると、以下のサイト
http://www.vector.co.jp/soft/win95/business/se25 …
などからEXCELのVBAマクロを使ったプログラムをダウンロードして研究してみるのはどうでしょう。
ご自分である程度作成できるようになったら、プログラムがご自分の望んでいる動作にならない場合などについてお尋ねいただいたほうがより具体的なアドバイスが返ってくるように思います。
参考URLにもその他のEXCELマクロを使用した販売管理ソフトなどがありますのでご覧下さい。

参考URL:http://www.nifty.com/download/win/business/hanba …
    • good
    • 0

>"C"列から"F"列の中で1つ以上空白のあるデータを検索して


>別シート2へそのままコピー出来るマクロ、

Sub FindBlank()
Dim Rng As Range
Dim i As Long
'Sheet2のフィールド行(名前,住所..)は、1行目にあるとします。
i = 2
Set Rng = Range("A1", Range("A65536").End(xlUp))
For Each c In Rng
 If Application.CountA(c.Offset(, 2).Resize(, 4)) <> 4 Then
   'シート2にコピー
   c.Resize(, 6).Copy Sheet2.Cells(i, 1)
   i = i + 1
 End If
Next
End Sub

こちらは意味が分かりません。
>シート2に表示されたデータで空白となっている"C"列から"F"列の項目名(請求書等)をシート3に用意してあるあいさつ文の書類名入力セル(ここではE10としておきます)に記入

この回答への補足

すみません。表現方法が悪くて・・・
たとえば
  A  B   C    D   E    F 
1名前 住所 請求書 納品書 領収書 到着確認書
2山田 東京  ○       ○
上の例ですと
"A2"の山田さんですと"D1:納品書"と"F1:到着確認書"が未確認(未到着)ですので、シート3(あいさつ文)のセル"E10"に"納品書;到着確認書"という文言(空白の部分が1つであれば、その書類名)を入れることなのですが・・

補足日時:2005/04/17 20:42
    • good
    • 0
この回答へのお礼

ありがとうございます。
コードを実行させたところ、空白の無いデータもシート2へコピーするのですが...そしてA列のみしかコピーされません。シート2へのコピーは行全部のデータをしたいのですが。..

お礼日時:2005/04/17 21:25

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QVBAで、アクティブなBOOKのファイル名を取得し

エクセルのVBAを使用して、選択されている、BOOKのファイル名を取得し、下記のように編集してA1セルに入れたいのですが、可能でしょうか?


BOOKのファイル名が「大阪_たこ焼き_1234.xls」の場合

大阪_と.xlsをは省いて、「たこ焼き_1234」がA1セルに入るようにしたい。

Aベストアンサー

拡張子なんでもござれ!
Sub TheBody()
Const xSeparator = "_"
Const xPeriod = "."
Dim KitCut As Variant
KitCut = Split(ActiveWorkbook.Name, xPeriod)
KitCut = Split(KitCut(0), xSeparator)
Range("A1").Value = KitCut(1) & xSeparator & KitCut(2)
Columns("A").AutoFit
End Sub

Qシート1のA列にある会社名を探してB列にある住所が入力されたら、シート2のB列に○を付けたい

シート1
A列        B列
株式会社A     東京都町田市…
株式会社B     
株式会社C     北海道札幌市…
↓↓↓↓↓
シート2
A列        B列
株式会社C     ○
株式会社A     ○
株式会社B

上記のように表示したいです。
できれば、関数でできれば助かります。

追加:シート2の会社名はシート1の会社名と順番が違います。

よろしくお願いします。

Aベストアンサー

こんばんは!

↓の画像でSheet2のB2セルに
=IFERROR(IF(VLOOKUP(A2,Sheet1!A:B,2,0)<>"","○",""),"")
という数式を入れフィルハンドルで下へコピーしています。m(_ _)m

QExcelVBA:自己のBook名を取得したい

WindowsXP-Proです。
Excelヴァージョンは2003です。

ExcelVBAでコーディングしています。
で、自分自身(つまり、このVBAコードを記述しているExcel本体)のBook名を取得したいのですが、何か関数は用意されていますでしょうか?

自分自身のBook名を取得したい理由は、VBAコードを記述しているExcel本体のファイル名(Book名)の名前が変更されても、VBAが正常に機能するように、今現在のBook名を取得したいのです。

複数のExcelファイルを、このVBAで操作しているため、
Workbooks("本体のBook名").Activate
を用いており、仮にファイル名(本体のBook名)の名前が変更されても、VBAが正常に機能できるように、"本体のBook名"部分を固定ではなく、可変で持てるようにしたいからです。

Aベストアンサー

Public Sub Auto_Open()
  MsgBox ActiveWorkbook.Name
  MsgBox ThisWorkbook.Name
End Sub

Private Sub Workbook_Open()
  MsgBox Me.Name
End Sub

いずれも、ブック名が表示されました。

Q宜しくお願いします。Excelで 田梅田 田田田 梅梅梅 田梅梅 と1つの列のセルに記載されてたら梅

宜しくお願いします。Excelで
田梅田
田田田
梅梅梅
田梅梅
と1つの列のセルに記載されてたら梅の字だけに赤のフォントで1発で塗ることできますか?宜しくお願いします

Aベストアンサー

エクセルのバージョンが書かれていませんが。
置換で可能です。
「検索と選択」→「置換」→[検索文字列]の欄に『梅』を入力→[置換の文字列]の欄に『梅』を入力
→「オプション」をクリック→[書式…]→(書式の変換)でフォントを選択し、[色]で『赤』を指定
[すべて置換]
でできます。

Q他のワークシート名の取得方法 (VBAを使用せずに)

VBAを用いずに、ワークシート関数のみでワークシート名を取得できないか探しています。

自分のシート名は、以下の出力結果の一部より取得することができました。
=CELL("filename")

しかし、他のシート名を取得する方法が思いもつきません。

VBAを用いずにシート名を取得することはできないのでしょうか?

Aベストアンサー

Excel2000でしたら、
1.[挿入]-[名前]-[定義] から、名前を2つ定義します。
  ・名前:PPP  参照範囲:=GET.WORKBOOK(1)
  ・名前:QQQ  参照範囲:=GET.DOCUMENT(88)
2.A1 に =SUBSTITUTE(INDEX(PPP,ROW()),"["&QQQ&"]","") と入力します。
3.A1 を下方にドラッグコピーすると、シート名が一覧で表示されます。

例えば3枚目のシート名のみを取得する場合は、任意のセルに
=SUBSTITUTE(INDEX(PPP,3),"["&QQQ&"]","") と入力します。

※マクロ関数というものですが、最近のバージョンにこれが付帯されているのかどうか
  わかりませんが。   ^_^;

QExcelで「A列で任意のグループ」「B列は空白以外」「C列は空白セル」の数

さきほど、質問をした者です。
回答を締め切った後で、追加質問がありますので、新たに質問させていただきます。(たびたびスミマセン)

Excelで「A列で任意のグループ」名、かつ、「B列は空白ではないセル」、かつ、「C列は空白セル」の件数を出したいのです。 (オートフィルタではなく。)

=SUMPRODUCT((A3:A271="グループ名")*(B3:B271="▲▲▲")*(C3:C271=""))

という式を作ったのですが、「B列の空白以外」という条件にする"▲▲▲"の部分はどうすればいいのでしょう?

Aベストアンサー

B3:B271<>""

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q空白セルを含む最終行変動データ行列で、特定の二つの列の空白セルのみに○を入力するマクロコードを教えて

空白セルを含む最終行変動データ行列で、特定の二つの列の空白セルのみに○を入力するマクロコードを教えて下さい。

Aベストアンサー

こんばんは!

>特定の二つの列・・・
とは具体的にどの列か判らないので、A・B列としてみました。

空白セルとは数式などによって空白に見えるセルではなく、何もデータがないセルだとします。

Sub Sample1()
Dim j As Long, lastRow As Long
For j = 1 To 2
lastRow = WorksheetFunction.Max(lastRow, Cells(Rows.Count, j).End(xlUp).Row)
Next j
If lastRow > 1 Then
On Error Resume Next '//←念のため//
Range(Cells(1, "A"), Cells(lastRow, "B")).SpecialCells(xlCellTypeBlanks).Value = "○"
End If
End Sub

こんな感じではどうでしょうか?m(_ _)m

こんばんは!

>特定の二つの列・・・
とは具体的にどの列か判らないので、A・B列としてみました。

空白セルとは数式などによって空白に見えるセルではなく、何もデータがないセルだとします。

Sub Sample1()
Dim j As Long, lastRow As Long
For j = 1 To 2
lastRow = WorksheetFunction.Max(lastRow, Cells(Rows.Count, j).End(xlUp).Row)
Next j
If lastRow > 1 Then
On Error Resume Next '//←念のため//
Range(Cells(1, ...続きを読む

QVBAでアカウント名を取得する方法

VBAで処理したEXCELブックをデスクトップに自動保存しようとしています。VBAで現在作業中のユーザーアカウント名を自動で取得する方法を教えていただきたいのですが。

デスクトップ上にブックを保存するには、パスを記述すればよいのですが、現在PC毎にユーザーアカウントを設定しユーザー名が異なっています。
このため、PC毎にこのユーザー名をデスクトップへのパスに入れ込まなければなりません。毎回キーボードからこのユーザー名を入力する方法もありますが、自動的にユーザー名を取得し、正しいパスを指定する方法を検討しています。
どなたか、VBAでこのユーザー名を取得する方法が有れば教えていただきたいのですが。
よろしくお願いいたします。

Aベストアンサー

Environ関数で、環境変数[USERNAME]を取得する。

MsgBox Environ("USERNAME")

Q列のデータを別の列に空白を詰めて表示するには

マクロでBC列のデータをBD列に空白を詰めて並べたいのですが、うまくいきません。

      BC列      BD列
5      25       19
6               39
7      3        25
8               3
9      8        8
10
関数で得たBC列の数値をBD列に空白を詰めて並べたいのですが、
BC列は5行目~20行、BD列は5行目から500行を設定しています。

BC列にマクロで表示された数値をBD列の、すでにある数値の次に並べようと思ったのですが、
時々BC列の数値がBD列に配置されませんでした。
BC列にはマクロで700回繰り返しますが、数値が得られるのは200回前後です。 色々試して見ましたが原因が掴めませんでした、よろしくお願いいたします。    

Step20:
 Dim i As Long Dim k As Variant
Dim j As Long

  k = Range("BD4").Value
For i = 5 To 20
If Cells(i, "BC") <> "" Then
For j = 5 To 500
If Cells(j, k) = "" Or Cells(k, "BD") = "" Then
Cells(k, "BD") = Cells(i, "BC")
Exit For
End If
Next
End If
k = k + 1
Next
If Cells(k, "BC") <> "" Then
GoTo Step20
End If

マクロでBC列のデータをBD列に空白を詰めて並べたいのですが、うまくいきません。

      BC列      BD列
5      25       19
6               39
7      3        25
8               3
9      8        8
10
関数で得たBC列の数値をBD列に空白を詰めて並べたいのですが、
BC列は5行目~20行、BD列は5行目から500行を設定しています。

BC列にマクロで表示された数値をBD列の、すでにある数値の次に並べよう...続きを読む

Aベストアンサー

こんな感じですか?
最後の終了条件がよくわかりませんでしたので修正してください。

Sub Sample()
  Dim srcRow As Long
  Dim dstRow As Long

Step20:
  dstRow = 5

  ' BD列で5行目より下の空白セルを探す
  Do While Cells(dstRow, "BD").Value <> ""
    dstRow = dstRow + 1
  Loop

  ' BC列で空白以外であればBD列にコピー
  For srcRow = 5 To 20
    If Cells(srcRow, "BC").Value <> "" Then
      Cells(dstRow, "BD").Value = Cells(srcRow, "BC").Value
      dstRow = dstRow + 1
    End If
  Next

  If Cells(4, "BC").Value <> "" Then GoTo Step20 ' ここの終了条件が良くわからない
  
End Sub

こんな感じですか?
最後の終了条件がよくわかりませんでしたので修正してください。

Sub Sample()
  Dim srcRow As Long
  Dim dstRow As Long

Step20:
  dstRow = 5

  ' BD列で5行目より下の空白セルを探す
  Do While Cells(dstRow, "BD").Value <> ""
    dstRow = dstRow + 1
  Loop

  ' BC列で空白以外であればBD列にコピー
  For srcRow = 5 To 20
    If Cells(srcRow, "BC").Value <> "" Then
      Cells(dstRow, "BD").Value = Cells(srcRow, "BC").Value
    ...続きを読む


人気Q&Aランキング

おすすめ情報