Excel VBA質問箱 IV

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

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


9215 / 76732 ←次へ | 前へ→

【73081】Re:コンボボックスでシート指定して、テキストボックスを反映
発言  UO3  - 12/11/5(月) 21:13 -

引用なし
パスワード
   ▼ぶたごりら さん:

ちょっと力技のような気もしますが、想定しておられると思われるレイアウトどおりに
転記したつもりです。

Private Sub コマンド登録_Click()

  Dim SiName As String
  Dim sx As Variant
  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Dim i As Long
  Dim wCol As Long
  Dim z As Long
  Dim dic As Object
  Dim x As Long
  Dim f As Range
  Dim c As Range
  
  'コンボボックスで選んだ名前を変数SiNameに格納する
  SiName = コンボ名前.Value
  If Len(SiName) = 0 Then
    MsgBox "シートが選ばれていません"
    Exit Sub
  End If
  '
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = 1 To 6
    If Len(Me.Controls("テキスト物品コード" & i).Value) > 0 Then
      dic(Me.Controls("テキスト物品コード" & i).Value) = Me.Controls("テキスト数量" & i).Value
    End If
  Next
  
  If dic.Count = 0 Then
    MsgBox "コードは何ですか?"
    Exit Sub
  End If
      
  Application.ScreenUpdating = False

  Set sh1 = Sheets(SiName)
  Set sh2 = Sheets("コード一覧")

  If IsEmpty(sh1.Range("E1").Value) Then
    z = 1
  Else
    z = sh1.UsedRange.Cells(sh1.UsedRange.Cells.Count).Row + 1
  End If

  sh1.Range("E" & z).Value = sh2.Range("B1").Value
  sh1.Range("F" & z).Value = sh2.Range("A1").Value
  
  wCol = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column + 2
  sh2.Cells(1, wCol).Value = sh2.Range("A1").Value
  i = 2
  For Each sx In dic
    sh2.Cells(i, wCol).Value = "'=" & sx
    i = i + 1
  Next

  sh2.Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=sh2.Cells(1, wCol).CurrentRegion, _
    CopyToRange:=sh1.Range("E" & z).Resize(, 2), Unique:=False
    
  Set f = sh1.Range("F" & z).Offset(1)
  If z > 1 Then Rows(z).Delete
  sh1.Range("F1").ClearContents
  sh2.Columns(wCol).Resize(, 2).Clear

  If Len(f.Value) > 0 Then
  
    For Each c In sh1.Range(f, sh1.Range("F" & sh1.Rows.Count).End(xlUp))
      c.EntireRow.Range("G1").Value = dic(c.Value)
      c.EntireRow.Range("B1").Value = テキスト日付.Value
      c.EntireRow.Range("C1").Value = テキスト納期.Value
      c.EntireRow.Range("A1").Value = Application.WorksheetFunction.Max(sh1.Range("A:A")) + 1
      c.ClearContents
    Next
  End If

 '入力したコントロールの値を初期化します。(元に戻します。)
  テキスト日付.Value = Format(Date, "yyyy/mm/dd")
  テキスト納期.Value = Format(Date + 14, "yyyy/mm/dd")
  テキスト物品コード1 = ""
  テキスト物品コード2 = ""
  テキスト物品コード3 = ""
  テキスト物品コード4 = ""
  テキスト物品コード5 = ""
  テキスト物品コード6 = ""
  テキスト数量1 = ""
  テキスト数量2 = ""
  テキスト数量3 = ""
  テキスト数量4 = ""
  テキスト数量5 = ""
  テキスト数量6 = ""
  コンボ名前 = ""
  テキスト日付.SetFocus

  Application.ScreenUpdating = True
  
End Sub
2 hits

【73072】コンボボックスでシート指定して、テキストボックスを反映 ぶたごりら 12/11/5(月) 14:08 質問
【73073】Re:コンボボックスでシート指定して、テキ... UO3 12/11/5(月) 14:34 発言
【73074】Re:コンボボックスでシート指定して、テキ... ぶたごりら 12/11/5(月) 14:54 発言
【73075】Re:コンボボックスでシート指定して、テキ... UO3 12/11/5(月) 15:42 発言
【73077】Re:コンボボックスでシート指定して、テキ... ぶたごりら 12/11/5(月) 16:47 発言
【73078】Re:コンボボックスでシート指定して、テキ... UO3 12/11/5(月) 17:06 発言
【73080】Re:コンボボックスでシート指定して、テキ... ぶたごりら 12/11/5(月) 18:51 発言
【73081】Re:コンボボックスでシート指定して、テキ... UO3 12/11/5(月) 21:13 発言
【73082】Re:コンボボックスでシート指定して、テキ... ぶたごりら 12/11/6(火) 15:44 発言
【73083】Re:コンボボックスでシート指定して、テキ... UO3 12/11/6(火) 17:13 発言

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