|    | 
     ▼Jto さん: 
 
以下ではいかがでしょうか。 
サンプルとしてリストボックスにはシートから3列、B,C,D列をセットするコードにしてあります。 
またリスト元ネタシート名を"Sheet1"としています。 
このあたりは、実際のものにチューニングしてください。 
プロパティでListBox1のColumnCountを適切なものに、またSpinButton1のEnableをFalseに 
設定しておいてください。 
 
Option Explicit 
 
Dim pos As Long 
Dim cnt As Long 
Dim skip As Boolean 
 
Private Sub CommandButton1_Click() 
  Call ListGet(1) 
End Sub 
 
Private Sub CommandButton2_Click() 
  Call ListGet(2) 
End Sub 
 
Private Sub CommandButton3_Click() 
  Call ListGet(3) 
End Sub 
 
Private Sub CommandButton4_Click() 
  Call ListGet(4) 
End Sub 
 
Private Sub CommandButton5_Click() 
  Call ListGet(5) 
End Sub 
 
Private Sub CommandButton6_Click() 
  Call ListGet(6) 
End Sub 
 
Private Sub CommandButton7_Click() 
  Call ListGet(7) 
End Sub 
 
Private Sub CommandButton8_Click() 
  Call ListGet(8) 
End Sub 
 
Private Sub CommandButton9_Click() 
  Call ListGet(9) 
End Sub 
 
Private Sub CommandButton10_Click() 
  Call ListGet(10) 
End Sub 
 
Private Sub ListGet(idx As Long) 
  Dim ch As String 
  Dim myR As Range 
   
  With Sheets("Sheet1")  'リストがあるシート名 
   
    ch = Array("あ", "か", "さ", "た", "な", "は", "ま", "や", "ら", "わ")(idx - 1) 
    Set myR = .Range("A2", .Range("A" & Rows.Count).End(xlUp)) 
    cnt = WorksheetFunction.CountIf(myR, ch) 
    If cnt = 0 Then 
      MsgBox "[" & ch & "]から始まる名前は登録されていません" 
    Else 
      pos = WorksheetFunction.Match(ch, myR, 0) + 1 
      With SpinButton1 
        skip = True 
        SpinButton1.Enabled = True 
        .Min = 1 
        .Max = cnt \ 10 + 1 
        If cnt Mod 10 = 0 Then .Max = .Max - 1 
        .Value = 1 
        skip = False 
      End With 
      Call ListSet 
    End If 
   
  End With 
   
  Set myR = Nothing 
 
End Sub 
 
 
Private Sub SpinButton1_Change() 
   
  If Not skip Then ListSet 
   
End Sub 
 
Private Sub ListSet() 
  Dim f As Long 
  Dim t As Long 
  Dim z As Long 
  Dim i As Long 
  Dim tbl() As String 
 
  If SpinButton1.Value = 0 Then Exit Sub 
   
  f = (SpinButton1.Value - 1) * 10 + pos 
  t = f + 10 - 1 
  z = pos + cnt - 1 
  If t > z Then t = z 
     
  ReDim tbl(1 To t - f + 1, 1 To 3)  'リストを仮に3列とする 
   
  With Sheets("Sheet1")  'リストがあるシート名 
    For i = f To t 
      tbl(i - f + 1, 1) = .Cells(i, "B").Value 'リストの1列目にB列を 
      tbl(i - f + 1, 2) = .Cells(i, "C").Value 'リストの1列目にC列を 
      tbl(i - f + 1, 3) = .Cells(i, "D").Value 'リストの1列目にD列を 
    Next 
  End With 
   
  ListBox1.List = tbl 
 
End Sub 
 | 
     
    
   |