以下、ご教示ください。
マクロ及びVBA初心者のため、何卒お願い致します。

まず、sheet1に毎日更新されるデータをダウンロードして貼り付けます。
具体的には株式市場に上場している全銘柄の株価です。(ここでは上段の画像となります)
この作業は毎日行うものです。

次にsheet2にすでにとある銘柄の過去の日々の株価データが蓄積されているのですが、
(ここでは下段の画像で、銘柄1376を例で記載しております。)
記載がある最後の行の次の行から、sheet1から1376を検索して、
名称や日時、株価の貼付けを実行することを自動化したいと考えております。

つまり、sheet1に全銘柄のデータを貼り付けたら、
sheet2の最後の行の次の行に最新の1376のデータが反映されるようにしたいのです。

(今回はsheet2だけで質問しておりますが、sheet30くらいまであるため)

worksheetFunction.Vlookupや
n=cell(Rows.count,"B").End(xlup).Row+1

このあたりを使用するのではと検討はついたのですが、
その先が詰まりました。

サンプルコードなどご教示いただきたくお願い致します。

「エクセルマクロ、VBAについて」の質問画像

A 回答 (4件)

No.1よりスマートに。



Sub WK()
Dim CNT As Long
Dim END1 As Long
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("A65536").End(xlUp).Row
END2 = Sh2.Range("A65536").End(xlUp).Row

Set 行 = Sh1.Range("A2:A" & END1).Find("1376")

If 行 Is Nothing Then
Else
Sh2.Range("A" & END2 + 1).Value = 1376
Sh2.Range("B" & END2 + 1).Value = Sh1.Range("B" & 行).Value
Sh2.Range("C" & END2 + 1).Value = Sh1.Range("C" & 行).Value
Sh2.Range("D" & END2 + 1).Value = Sh1.Range("D" & 行).Value

End If
End Sub
    • good
    • 0
この回答へのお礼

助かりました

ありがとうございます。
今出先のため、pc触れる環境になりましたら、挑戦させて頂きます!

お礼日時:2017/05/15 09:44

ANo3です



1列目が数字として入力されているかもしれませんでしたね。

安全側の判断とするため、3行目の宣言文を訂正しておきます。
(訂正前)Dim rw As Long, index As Long, id As String
 ↓↓↓
(訂正後)Dim rw As Long, index As Long, id
    • good
    • 0
この回答へのお礼

ありがとうございます。
勉強になります。
まだまだ難しいですが、試行錯誤しながら勉強します。

お礼日時:2017/05/16 06:42

勝手に想定してますが・・・



Sub Sample()
Dim sh As Worksheet, tbl As Range
Dim rw As Long, index As Long, id As String

Set tbl = Worksheets("Sheet1").Range("A:A")
Set tbl = tbl.Cells(1, 1).Resize(tbl.Cells(Rows.Count, 1).End(xlUp).Row, 3)

For Each sh In Worksheets
 id = sh.Cells(2, 1).Value
 If sh.Name <> "Sheet1" And id <> "" Then
  index = 0
  On Error Resume Next
  index = WorksheetFunction.Match(id, tbl.Columns(1), 0)
  On Error GoTo 0

  If index > 1 Then
   rw = sh.Cells(Rows.Count, 1).End(xlUp).Row
   If sh.Cells(rw, 3).Value < tbl.Cells(index, 3).Value Then
    tbl.Rows(index).EntireRow.Copy Destination:=sh.Rows(rw + 1)
   End If
  End If
 End If
Next sh

End Sub
    • good
    • 0

Sub WK()


Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
END1 = Sh1.Range("A65536").End(xlUp).Row
END2 = Sh2.Range("A65536").End(xlUp).Row

Sh2.Range("A" & END2 + 1).Value = 1376

Sh2.Range("B" & END2 + 1).Value = Application.WorksheetFunction.VLookup(Sh2.Range("A" & END2 + 1).Value, Sh1.Range("A2:D" & END1 + 1).Value, 2, False)

 Sh2.Range("C" & END2 + 1).Value = Application.WorksheetFunction.VLookup(Sh2.Range("A" & END2 + 1).Value, Sh1.Range("A2:D" & END1 + 1).Value, 3, False)

Sh2.Range("D" & END2 + 1).Value = Application.WorksheetFunction.VLookup(Sh2.Range("A" & END2 + 1).Value, Sh1.Range("A2:D" & END1 + 1).Value, 4, False)

End Sub
    • good
    • 0

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

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


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

人気Q&Aランキング

おすすめ情報