Excel VBA質問箱 IV

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

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


37160 / 76732 ←次へ | 前へ→

【44746】シートの差換えについて
質問  伊藤  - 06/11/30(木) 16:12 -

引用なし
パスワード
   本から入手したマクロで受注管理をしております。
sheets("受注台帳")を一定期間(1年間)毎差換えたいのですが方法を
教えてください。
又は、現行のsheets(”受注台帳")のデーターをDeleteで削除して最初の行から
データーを入力出来るようにする。
Deleteでデーターを削除しても,その後、入力したデーターが削除前のデーターの
後の行に入力されます。
宜しくお願いします。


Private Sub cmd終了_Click()

  Dim intRet As Integer
  Dim rngTmp As Range
  Dim strAdd As String, strBanchi As String
  
  intRet = MsgBox("受注データの追加を終了して" & _
    vbCrLf & "メニューに戻ります", vbOKCancel, "終了確認")
  If intRet = vbOK Then
    
    ' 受注伝票番号を管理台帳に書き戻す
    cnt管理 = [管理データ].Range("管理データ").Rows.Count
    Set rng管理 = Range("管理データ").Rows(cnt管理)
    Application.Goto rng管理.Cells(1)
    rng管理.Cells(1, 1) = sng売伝WK
    
    ' 受注データの範囲を再定義する
    Set rng受注 = Sheets("受注台帳").Range("受注データ").CurrentRegion
    Set rngTmp = Application.Union(Range("受注データ"), rng受注)
    strAdd = rngTmp.Address(external:=True)
    strBanchi = "=" & strAdd
    ThisWorkbook.Names("受注データ").RefersTo = strBanchi
      
  End If
End Sub


Private Sub UserForm_Initialize()
  Dim intLp As Integer
   
  '売上データ入力で使用するオブジェクトの指定
  Set txt商品コード(1) = txt商品コード1
  Set drp商品名(1) = drp商品名1
  Set txt図番(1) = txt図番1
  Set txt部品名(1) = txt部品名1
  Set txt計算(1) = txt計算1
  Set txt個数(1) = txt個数1
  Set txt単重量(1) = txt単重量1
  Set txt総重量(1) = txt総重量1
  Set txt単価(1) = txt単価1
  Set txt金額(1) = txt金額1

  Set txt図番(2) = txt図番2
  Set txt部品名(2) = txt部品名2
  Set txt計算(2) = txt計算2
  Set txt個数(2) = txt個数2
  Set txt単重量(2) = txt単重量2
  Set txt総重量(2) = txt総重量2
  Set txt単価(2) = txt単価2
  Set txt金額(2) = txt金額2
  
  ' 管理台帳から最新の売上伝票番号を取得する
  Set rng管理 = Range("管理データ").Rows(2)
  sng売伝 = rng管理.Cells(1, 1)
  sng売伝WK = sng売伝
   
  '商品レコード数のセット
  Set rng商品 = Range("商品データ").CurrentRegion
  cnt商品 = rng商品.Rows.Count - 1
  
  '商品レコード領域(データ部分)を指定する。
  Set rng商品 = rng商品.Offset(1, 0).Resize(cnt商品)
  
  ' 商品名を配列に格納
  ReDim syArray(cnt商品)
  For intLp = 0 To cnt商品 - 1
    syArray(intLp) = rng商品.Cells(intLp + 1, 2)
  Next intLp
  
  '受注レコード数のセット
  Set rng受注 = Sheets("受注台帳").Range("受注データ")
  cnt受注 = rng受注.Rows.Count
  
  Set rec受注 = Range("受注データ").Rows(cnt受注).Offset(1)
  Application.Goto rec受注.Cells(1)
  cnt行 = cnt受注 + 1
  
  
End Sub
0 hits

【44746】シートの差換えについて 伊藤 06/11/30(木) 16:12 質問

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