芸人が音声解説 「オレたちの甲子園」

  A  B    C
1 山田 地下鉄  160 
2    地下鉄  150
3    タクシー 1120
4    地下鉄  150
5 鈴木 地下鉄  210
6    タクシー 5220

上記のようなデータがあり、VBAで別シートに
A2~A4までA1の山田が、A6にはA5の鈴木が
入った形でコピーしたいのですが、実現可能でしょうか?
よろしくお願いいたします。

※添付画像が削除されました。

A 回答 (6件)

Dim i As Integer


Dim S As String
S = ""
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = S
Else
S = Cells(i, 1).Value
End If
Next i
    • good
    • 8
この回答へのお礼

nag0720様、ご回答ありがとうございます。
変数Sの使い方が大変勉強になりました。
記述いただきました内容でやりたいことが無事できました。

お礼日時:2009/08/19 20:47

Dim rr As Range


Dim rb As Range
Dim i As Long
Set rr = Range("A1", "A" & Cells(Rows.Count, 2).End(xlUp).Row)
Set rb = rr.SpecialCells(xlCellTypeBlanks)
For i = 1 To rb.Areas.Count
With rb.Areas(i)
.Value = .Item(1).Offset(-1).Value
End With
Next i

スペースとか、長さ0の文字列、が入っている見かけが空白セルの場合は別途対策が必要です。
    • good
    • 1
この回答へのお礼

xls88様、ご回答ありがとうございました。
色々な書き方があって大変勉強になります。

お礼日時:2009/08/19 20:55

以下の手順で行ってください。



(1)まずは以下のコードをモジュールに貼り付けてください。

Sub コピー()
Dim i As Integer, s As Worksheet, s1 As Worksheet, x As String
Set s = Sheets("Sheet1") '(1)「Sheet1」の6文字をコピー元のシート名に変更
Set s1 = Sheets("Sheet2") '(2)「Sheet2」の6文字をコピー先のシート名に変更
For i = 1 To s.Range("B" & Rows.Count).End(xlUp).Row
If Not s.Cells(i, 1).Value = "" Then x = s.Cells(i, 1).Value
s.Range("A" & i & ":" & "C" & i).Copy s1.Range("A1").Offset(i - 1)'(3)
s1.Range("A1").Offset(i - 1) = x
Next i
End Sub

(2)そしてコードの緑色の部分(1)(2)を指示通りに変更してください。
(3)マクロを実行してください。(どのシートを開いてマクロを実行してもOKです。)

きちんと動きましたか?

A列からC列を処理するようにしています。もし行一列すべてをコピーしたいなら(3)の

s.Range("A" & i & ":" & "C" & i).Copy s1.Range("A1").Offset(i - 1)'(3)

を消して

s.Rows(i).Copy s1.Range("A1").Offset(i - 1)

に変更してください。
    • good
    • 0
この回答へのお礼

yuujgmn様、ご回答ありがとうございます。
丁寧に教えていただきまして助かりました。

お礼日時:2009/08/19 20:48

A列において、A2からデータがある行まで選択します。


Ctrl+Gで「ジャンプ」画面を開きます。
ジャンプ画面の「セル選択」で「選択オプション」を開きます。
空白セルを選択してOKを押します。(A列の複数の空白セルのみが選択されます)
「名前ボックス」が「A2」となっていることを確認したら、数式バーに「=A1」と入力し、Ctrl+Enterします。

以上です。

この回答への補足

cistronezk様、ご回答ありがとうございます。
毎回、元の形式で新しいデータが届くため、ワンボタンで
処理できるようにしたいと考えております。
説明不足で申し訳ございません。

補足日時:2009/08/19 14:41
    • good
    • 0

VBAを使用しなくても、次の式をE2セルに入力して下方にオートフィルドラッグすればよいでしょう。


=IF(A2<>"",A2,IF(AND(A2="",B2<>""),A1,""))

この回答への補足

KURUMITO様、ご回答ありがとうございます。
元のデータが5000件以上あり、毎日新しく届くため、
VBAで取込処理をしたいと考えております。
また、その為の列も極力用意したくないため、VBAでの方法を
ご教授いただければとご相談しました。
説明不足で申し訳ございません。

補足日時:2009/08/19 14:38
    • good
    • 1

あの・・・



D1セルに =A1
D2セルに =IF(A2="",D1,A2)
D2セルをD3セル以降にコピー

これだけで、D列にお望みのデータが出来上がりますけど・・・。
後は適当に「コピー」「形式を選択して貼り付け:値」にすれば。

この回答への補足

FEX2053様、早速のご回答ありがとうございます。
それ用に列を用意しなくて済む方法があればと思い
相談させていただきました。説明不足で申し訳ございません。

補足日時:2009/08/19 14:13
    • good
    • 1

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

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

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

Q[エクセル] セルが空だったら一つ上のセルを自動入力する

こちらには困ったときにいつもお世話になっております。
今回もよろしくお願いいたします。

EXCEL2002にて、セルが空だったら一つ上のセルを自動入力するようにしたいのです。状況といたしましては、ある個人情報管理アプリケーションが、吐き出すCSVファイルがあります。それが、困ったことに一人の人に複数の情報がある場合、個人情報ナンバーを省略します。わかりずらいと思いますので、以下の表をご覧ください。

個人情報ID 電話番号
0001     01-2345-1111
0002     01-2345-2222
        01-2345-2223
0003     01-2345-3333
        01-2345-3334
        01-2345-3335
        01-2345-3336
0004     01-2345-4444

以上のような表になります。そこで、「0002」の下の空のセルにも0002。「0003」の下の3つの空のセルすべてに0003を自動的に入力できるようにしたいのです。各々コピーしていけば何とか埋まるのですが、データ量が多くかなり時間がかかってしまいます。

解決方法をご存知の方がいらっしゃいましたら、お力添えの程、よろしくお願いいたします。

こちらには困ったときにいつもお世話になっております。
今回もよろしくお願いいたします。

EXCEL2002にて、セルが空だったら一つ上のセルを自動入力するようにしたいのです。状況といたしましては、ある個人情報管理アプリケーションが、吐き出すCSVファイルがあります。それが、困ったことに一人の人に複数の情報がある場合、個人情報ナンバーを省略します。わかりずらいと思いますので、以下の表をご覧ください。

個人情報ID 電話番号
0001     01-2345-1111
0002     01-2345-2222
...続きを読む

Aベストアンサー

こんにちは

・A列の対象範囲を選択
・編集 ジャンプ セルの選択 「空白セル」にチェック
・数式バーに =An(注) と入力後
 [Ctrl]を押したまま[Enter] で入力確定

セル行(n) はアクティブセルの直上セル行値です
 対象セル(空白セル)が選択された状態で1箇所だけ
 反転していないセルがアクティブセルです。
例えば以下の場合
 A4がアクティブセルになっている筈なので =A3 と
 なります。

   A       B
1 個人情報ID 電話番号
2 0001     01-2345-1111
3 0002     01-2345-2222
4         01-2345-2223
5 0003     01-2345-3333
6         01-2345-3334
7         01-2345-3335
8         01-2345-3336
9 0004     01-2345-4444

Qエクセルで上の行の値を自動的にコピーする

どなたか教えて欲しいのですが

大阪営業所
 (空白)
 (空白)
南大阪店
 (空白)
東大阪営業所
 (空白)
 (空白)
 (空白)
以下同様のパターンの表があった場合、
現在(空白)の部分に前に表示されていた値を表示したいのです。
大阪営業所
大阪営業所 
大阪営業所 
南大阪店
南大阪店 
東大阪営業所
東大阪営業所

こんな風にしたいのですが関数を使って出来ますか?
よい方法があれば教えてください。

Aベストアンサー

こんにちは。

挙げられてる例がA列だとして、
データの範囲(空白を含む)であるセルA1~A9を選択します。
CTRLキー+ G を押します。
「ジャンプ」のダイアログが出ますんで、セル選択を押します。
「空白セル」をチェックして、「OK」ボタンを押します。

空白セルだけ選択された状態になりますので、そのままの状態で
=A1 と式を入力し、 CTRLキー+ENTER として確定します。

これで、空白だったセル全体に一行上のセルと同じ内容が入りますので、
そのままでもいいですし値のコピー貼り付けなどで確定されるのも良いでしょう。

では(^^♪

Qエクセル もし、セルが空欄なら、その上のセルの値を入力する

エクセル2002を使用しています。

例えば、A列に順に数値が入っているのですが、ところどころ空欄です。
<こんな感じです。>
12
15
22

33
34


55
<ここまで>

数値は、連番ではありません。不規則です。約300行あります。
本当は、空欄の場所は一つ上のセル数値が入るのです。(連続して空欄になっているところも、一つ上の数値と同じ値が入るのです。)
<上の例を当てはめると>
12
15
22
22 ←
33
34
34 ←
34 ←
55
<ここまで>

こんな感じにしたいのです。
関数などで一つのセルに入力して、あとはフィルドラッグでコピーするなんていう便利な方法はありませんか?
すでに入力している数値が消えないようにしたいのです。

よろしくお願いいたします。

Aベストアンサー

とりあえず数値の範囲を選択
F5キーを押してセル選択で定数を選択(文字を除くなら数値のみチェック)
これで空白のセルが除外されます。
ここでコピーして張り付ければいいかと...

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。

以下のようなプログラムをVBAで作成したいと考えています。

A1のセルに値があれば、その値をB1に返す。
次にA2のセルに値があれば、その値をB2に返す。
A行に値がある一番下のセルまで同じようなことをさせたいと考えています。

VBAは初心者です。
どなかた宜しくお願い致します。

Aベストアンサー

#2さんと似たものですが・・・・参考にしてください。

Sub test001()
Dim i As Long
i = 1
Do While Cells(i, 1) <> ""
Cells(i, 2) = Cells(i, 1)
i = i + 1
Loop
End Sub

Q[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。

VBAで指定列からAを検索し、発見したら隣のセルに0を入れるマクロを組みたいのですが、組み方がVBA初心者の為わかりません。
(例)
L列に、A、B、C、D、E、Fとランダムに文字が入っていて、
文字Aを検索し、発見したら隣のI列に値0を入れるというマクロです。

Sub Search()
Dim A As String
Set A = Worksheets("Sheet1").Cells.Find("A")
If A Is Nothing Then
ActiveCell.Offset(0, 1).Value = 0

End If
End Sub
と過去の質問で考えてみたのですが、Aがあった時、、、、
とコードが書けないです。
大変困っているので、ご教授頂けないでしょうか?
出来れば、そのままマクロに出来るコードを教えて頂けないでしょうか?
宜しくお願い致します。

Aベストアンサー

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表格が、この「Find」 です。

>Set A = Worksheets("Sheet1").Cells.Find("A")

>過去の質問で考えてみたのです

どうも、Find メソッドは、あるレベル以下の人は、省略する傾向があるようです。何が大事で、何が大事でないかというのは、やってみなければ分かりませんが、検索語だけを入れる書き方は、実務では、あまりしないほうがよいと思います。

だいたい、以下のTestFind2 ぐらいまでに、省略は、とどめたほうがよいです。

それは、Find は、必ずしも自分が思っているデフォルトとは違うことがあるので、「明示的(意図的に)」にオプションは入れたほうがよいです。
例えば、大文字小文字の違いを付けるなら、MatchCase:=True, 数式まで探すなら、LookIn:=xlFormulas

なお、Find メソッドは、5年経っても、たぶん完全に覚えられません。面倒なコードのひとつです。ですが、これはパターンが決まっているので、ひとつパターンが決まったら、それに当てはめればよいだけです。

#3さんで示されているMougのサンプルコードと似てはいるのですが、Mougのサンプルコードでは、Verionによって、失敗することがあります。

'--------------------------------------
'記録マクロをそのまま使う方法
Sub TestFind1()
Dim c As Range
 Set c = Columns("L:L").Find(What:="A", _
           After:=ActiveCell, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, _
           MatchByte:=False, _
           SearchFormat:=False)
 c.Offset(0, 1).Value = 0
End Sub
'--------------------------------------
'TestFind1 をアレンジしてみる
Sub TestFind2()
Dim c As Range
'検索語
Const MYTXT As String = "A"
 Set c = ActiveSheet.Columns("L:L").Find(What:=MYTXT, _
           LookIn:=xlValues, _
           LookAt:=xlPart, _
           MatchCase:=False)
 If Not c Is Nothing Then
    c.Offset(0, 1).Value = 0
 End If
End Sub

'---------------------------------------
'複数ある場合(パターンを使った方法)
'---------------------------------------
Sub TestFind3()
  Dim c As Range
  Dim FirstAdd As String
  Const MYTXT As String = "A"
  Set c = ActiveSheet.Columns("L:L").Find( _
    What:=MYTXT, _
    LookIn:=xlValues, _
    LookAt:=xlPart, _
    MatchCase:=False)
  
  If Not c Is Nothing Then
    FirstAdd = c.Address
    Do
      c.Offset(, 1).Value = 0
      Set c = ActiveSheet.Columns("L:L").FindNext(c)
      If c.Address = FirstAdd Then Exit Sub
    Loop Until c Is Nothing
  End If
End Sub

こんばんは。

#3さんのおっしゃっていることも、もっともなのですが、気になる点がありましたので、自分のことを踏まえて、書かせていただきます。

いずれ、また、同じようなケースが出会うと思います。こんな原則を考えてみたらどうでしょうか?それは、私も自身も同じなのですが、ワークシートのコマンドで行われるものは、記録マクロから作ってみるということです。他にも、「統合」とか、「置換」とか「オートフィルタ」「フィルタオプション」とかは、みんなパターンが決まっています。
その中の代表...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?

Q指定した文字があった場合、その行を削除するマクロが欲しいです

指定した文字があった場合、その行を削除するマクロが欲しいです
Sheet1(Sheet1以外は対象外)のB列に
XYZ
という文字があった場合、その行をすべて削除する
というマクロはどのように作ればいいでしょうか?
お時間ある方アドバイスいただければ幸いです。

Aベストアンサー

手抜きですがこんな感じでどうでしょう。
削除する行が多いなら画面更新を停止した方が良いでしょう。

Sub Sample()
 Sheets("Sheet1").Select
 Do While (True)
  Columns("B:B").Select
  Set mySelect = Selection.Find(What:="XYZ")
  If mySelect Is Nothing Then Exit Do
  Rows(mySelect.Row).Select
  Selection.Delete Shift:=xlUp
 Loop
End Sub

Qマクロ 空白セルへの文字入力

A列が空白となるまでB列のとこどころに数字が入力されていて空白のセルへ0を入力する。
というマクロがどうしてもできないのですが、ご教示お願いします。

Aベストアンサー

A1セルから対象データが入っているとして、
簡単に書くとこんな感じでしょうか。

Dim i As Long

 i = 1

Do Until Cells(i, 1).Value = ""

If Cells(i, 2).Value = "" Then
Cells(i, 2).Value = "0"
End If

i = i + 1

Loop

他にもパターンはいくつかありますが、これが一番シンプルだと思いましたので。

QVBAで空白セルにのみ数値を代入する方法

御伺いしたい事があります。
例えば
セルA2に何も数値が書かれていない空白状態ならば、VBAでだした数値を代入して終了。

もし空白で無いのならば、セルをA2から1つ下のA3で空白かどうかの判定をする(空白のセルが来るまで続ける)

といったように、積み上げ形式でどんどんセルを動きながら代入を行いたいのですが

これを行うには、どういったVBAでの記述が必要なのでしょうか?
よろしくお願いいたします。

Aベストアンサー

こういう感じで良いのでしょうか。

Private Sub SetVariableToBlankCell()
  Dim i As Integer

  For i = 1 To 65536
    If Range("A" & i).Value = "" Then
      Range("A" & i).Value = 100
      Exit For
    End If
  Next i
End Sub


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング