Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2959 / 13646 ツリー ←次へ | 前へ→

【65058】転記のVBAを教えてください。 八家九僧陀 10/4/9(金) 18:31 質問[未読]
【65059】Re:転記のVBAを教えてください。 Hirofumi 10/4/10(土) 5:47 発言[未読]
【65060】Re:転記のVBAを教えてください。 八家九僧陀 10/4/10(土) 19:11 回答[未読]
【65061】Re:転記のVBAを教えてください。 八家九僧陀 10/4/10(土) 19:14 回答[未読]
【65067】Re:転記のVBAを教えてください。 Hirofumi 10/4/10(土) 23:57 回答[未読]

【65058】転記のVBAを教えてください。
質問  八家九僧陀  - 10/4/9(金) 18:31 -

引用なし
パスワード
   次のような仕様になっているワークシート(入力表)のデータを、別シートの1行づつに転記、蓄積したのですが、VBAを教えてください。

A2に年月日、B2に店舗名
A5に品名あ、A6に個数、A7に金額、B5に品名い、B6に個数、B7に金額、
A8に品名う、A9に個数、A10に金額、B8に品名え、B9に個数、B10に金額、
A11に品名お、A12に個数、A13に金額、B11に品名か、B12に個数、B13に金額、
という風に、一品目づつ縦に3行、A列からT列までデータが入力されます。
そのシートデータを、別シートの新規入力行1行に転記したいのです。

(以下、入力表→別シートという風に例表記します)
A2→A列に、B2→B列に、A5→C列に、A6→D列に、A7→E列に、B5→F列に、B6→G列に、B7→H列に、A8→I列に、A9→J列に、A10→K列に、B8→L列に、B9→M列に、B10→N列に、入力表に入力された一年月日、一店舗づつの入力データを、別シートの新規入力行に一行づつ転記する

【65059】Re:転記のVBAを教えてください。
発言  Hirofumi  - 10/4/10(土) 5:47 -

引用なし
パスワード
   不明な点が在るのでお聞きしたいのですが?

1、転記元のワークシート(入力表)で
 a、データ最終行は決まっているのですか?
 b、1シートは、1年月日の1店舗分ですか?
  それとも、2列づつが1年月日の1店舗分でT列までですか?
 c、C2、D2・・S2、T2は、年月日、店舗と記述されているのですか?
  それとも、何も無いのですか?
 d、転記後、入力表のデータは消去するのですか?

2、別シート(転記先)に就いて
 a、出力先の先頭行は何処ですか?
 b、転記先シートは店舗別ですか?
  店舗別なら、シート名は店舗名で善いですか?

【65060】Re:転記のVBAを教えてください。
回答  八家九僧陀  - 10/4/10(土) 19:11 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございます。説明不足ですみません。

>1、転記元のワークシート(入力表)で
> a、データ最終行は決まっているのですか?
 →入力表が見える範囲ですので、range("T13")が最終セルです。
> b、1シートは、1年月日の1店舗分ですか?
>  それとも、2列づつが1年月日の1店舗分でT列までですか?
 →1入力表(シート)に1年月日・1店舗分です。
> c、C2、D2・・S2、T2は、年月日、店舗と記述されているのですか?
>  それとも、何も無いのですか?
 →A2,B2に見出し的に年月日と店舗名が表示されています。C2以降は空白です。
> d、転記後、入力表のデータは消去するのですか?
 →転記後は消去して、次の店舗分を新規入力します。
※別の処理となりますが、入力用だけでなく、A2,B2に年月日、店舗名を入力すれば、格納したデータから該当データを検索して表示できたらとも考えています。
WorkSheetFunction.Vlookupでできるかなと思っています。
>2、別シート(転記先)に就いて
> a、出力先の先頭行は何処ですか?
 →A列の新規入力行です。
  range("A65536").End(XlUp)activate
  Activecell.OffSet(1,0).Activateで新規転記先を取得しようと考えています。
> b、転記先シートは店舗別ですか?
>  店舗別なら、シート名は店舗名で善いですか?
 →Sheet("H22")に平成22年度の全店舗データを格納、蓄積してデータ活用しようと考えています。

よろしくお願いします。

【65061】Re:転記のVBAを教えてください。
回答  八家九僧陀  - 10/4/10(土) 19:14 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございます。説明不足ですみません。

>1、転記元のワークシート(入力表)で
> a、データ最終行は決まっているのですか?
 →Scrollやpagedownせずにシートに入力表が見える範囲ですので、range("T13")が最終セルです。
> b、1シートは、1年月日の1店舗分ですか?
>  それとも、2列づつが1年月日の1店舗分でT列までですか?
 →1入力表(シート)に1年月日・1店舗分です。
> c、C2、D2・・S2、T2は、年月日、店舗と記述されているのですか?
>  それとも、何も無いのですか?
 →A2,B2に見出し的に年月日と店舗名が表示されています。C2以降は空白です。
> d、転記後、入力表のデータは消去するのですか?
 →転記後は消去して、次の店舗分を新規入力します。
※別の処理となりますが、入力用だけでなく、A2,B2に年月日、店舗名を入力すれば、格納したデータから該当データを検索して表示できたらとも考えています。
WorkSheetFunction.Vlookupでできるかなと思っています。
>2、別シート(転記先)に就いて
> a、出力先の先頭行は何処ですか?
 →A列の新規入力行です。
  range("A65536").End(XlUp)activate
  Activecell.OffSet(1,0).Activateで新規転記先を取得しようと考えています。
> b、転記先シートは店舗別ですか?
>  店舗別なら、シート名は店舗名で善いですか?
 →Sheet("H22")に平成22年度の全店舗データを格納、蓄積してデータ活用しようと考えています。

よろしくお願いします。

【65067】Re:転記のVBAを教えてください。
回答  Hirofumi  - 10/4/10(土) 23:57 -

引用なし
パスワード
   こんな事で善いのかな?
理解して居なかったらごめん

Option Explicit

Public Sub Main()

  '画面更新を停止
  Application.ScreenUpdating = False
  
  '1シート分処理
  Transfer ActiveSheet.Range("A5:T13"), Worksheets("H22").Range("A1")

  '画面更新を再開
  Application.ScreenUpdating = True
  
  MsgBox "処理が完了しました", vbInformation
     
End Sub

Private Sub Transfer(rngList As Range, rngResult As Range)

  '1品目の行数
  Const clngPitch As Long = 3
  
  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim l As Long
  Dim m As Long
  Dim lngRows As Long
  Dim vntResult1 As Variant
  Dim vntResult2 As Variant
  Dim vntData As Variant

  '結果シートに就いて
  With rngResult
    '最終行の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      lngRows = 0
    End If
  End With
  
  'List範囲に就いて
  With rngList
    '年月日、店舗名を配列に取得
    vntResult1 = .Cells(1, 1).Offset(-3).Resize(, 2).Value
    'データ列が偶数であるのを確認し、奇数なら1列増やして偶数にし配列に取得
    If .Columns.Count Mod 2 = 0 Then
      'データを配列に取得
      vntData = .Value
    Else
      vntData = .Resize(, .Columns.Count + 1).Value
    End If
  End With
  
  '結果用配列を確保
  ReDim vntResult2(1 To UBound(vntData, 1) * UBound(vntData, 2))
  
  'データを結果用配列に転記
  For i = 1 To UBound(vntData, 2) Step 2 '2列づつ処理
    For j = 1 To UBound(vntData, 1) Step 3 '3行づつ処理
      For k = 0 To 1 '奇数列、偶数列を処理
        For l = 0 To 2 '品名、個数、金額を処理
          m = m + 1
          vntResult2(m) = vntData(j + l, i + k)
        Next l
      Next k
    Next j
  Next i
  
  'データを出力
  With rngResult
    .Offset(lngRows + 1).Resize(, UBound(vntResult1, 2)).Value = vntResult1
    .Offset(lngRows + 1, UBound(vntResult1, 2)) _
        .Resize(, UBound(vntResult2)).Value = vntResult2
  End With
  
  'データを消去
'  With rngList
'    .Cells(1, 1).Offset(-3).Resize(, 2).ClearContents
'    .ClearContents
'  End With
  
End Sub

2959 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free