人に聞けない痔の悩み、これでスッキリ >>

教えてください。
ユーザーフォームにリストボックス(Listbox1)があり、日付が昇順で入力されるようになっています。
ただし、この日付データは重複が多いため重複されないよう表示しようと下記のコードを記述しましたが「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」と表示されてしまいます。
これを回避し、実行させるためにはどういう風に記述を修正したらよいでしょうか?
================================================================
Private Sub UserForm_Initialize()

Dim i As Long
For i = 2 To 2000
ListBox1.AddItem Worksheets("データ").Cells(i, 1)

Dim myValue As Variant
Dim myRng As Range, myCell As Range

Set myRng = Worksheets("データ").Cells(i, 1).End(xlUp)
myValue = myRng.Value

Application.ScreenUpdating = False

myRng.Sort Worksheets("データ").Cells(i, 1), xlAscending, Header:=xlYes


With ListBox1
.Clear
For Each myCell In myRng.Resize(myRng.Rows.Count - 1).Offset(1) _
.SpecialCells(xlCellTypeVisible)
.AddItem myCell.Value
Next
.ListIndex = 0
End With
Next i
ListBox1.ListIndex = 0
End Sub
================================================================

このQ&Aに関連する最新のQ&A

A 回答 (4件)

> 抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出


> されません。

すみません。寝ぼけてたみたいです。#3 もおかしなコードですね...
AddItem ではなく、 List の方が楽なので変更しましたが、これで大丈夫な
はずです。きっと(´・ω・`)

Private Sub UserForm_Initialize()

  Dim i      As Long
  Dim lngR    As Long
  Dim myRng    As Range
  Dim Buffer   As Variant
  
  With Worksheets("データ")
    lngR = .Cells(65536, "A").End(xlUp).Row
    Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))
    myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
    .Range("B:B").ClearContents
    myRng.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=.Range("B1"), _
               Unique:=True
    lngR = .Cells(65536, "B").End(xlUp).Row
    Buffer = Range(.Cells(2, "B"), .Cells(lngR, "B")).Value
  End With
  With ListBox1
    .Clear
    .List = Buffer
    .ListIndex = 0
  End With

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

出来ました!!
どうもありがとうございました◎

お礼日時:2006/08/10 12:38

すみません。

#1 のコードはところどころで必要なピリオド抜けが多いので、
バグフィックスしたものを再掲しておきます。スペース節約のため、コメント
はカットしてます。

 # No.2 のコメントにも一部誤記があります。
 # ×降順ソート --> ○昇順ソート

Private Sub UserForm_Initialize()

  Dim i      As Long
  Dim lngR    As Long
  Dim myRng    As Range

  With Worksheets("データ")
    lngR = .Cells(65536, "A").End(xlUp).Row
    Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))
    myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
    .Range("B:B").ClearContents
    myRng.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=.Range("B1"), _
               Unique:=True
    lngR = .Cells(65536, "B").End(xlUp).Row
    Set myRng = Range(.Cells(2, "B"), .Cells(lngR, "B"))
  End With
  With ListBox1
    .Clear
    For i = 2 To lngR - 1
      .AddItem myRng.Cells(i, 1).Value
    Next i
  End With
  ListBox1.ListIndex = 0

End Sub

この回答への補足

解答ありがとうございます。
参考にさせていただいたのですが、抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出されません。
これはどの部分を修正したらよいでしょうか?

補足日時:2006/08/10 09:18
    • good
    • 1

AddItem だとちょっと「もたつく」感じがします。

配列にして List プロパ
ティーで一気に放り込んだ方が高速です。

Range を一次元配列にする方法、配列から重複値をドロップする方法なども
あわせて書いてみました。少々難易度はあがりますが、ご参考下さい。

Private Sub UserForm_Initialize()
  ' イベントプロシージャ内にはあまり長いコードは書かないで
  ' サブプロシージャを呼び出すようにするとコードがスッキリ
  ' します
  Call SetListbox

End Sub

' リストボックスデータセット
Private Sub SetListbox()
  
  Dim i      As Long
  Dim rngDataTbl    As Range
  Dim lngR As Long
  Dim Buffer   As Variant
  
  On Error GoTo ERROR_HANDLER
  
  With ThisWorkbook.Worksheets("データ")
    ' データの最終行を求め、データ範囲を rngDataTbl に参照
    lngR = .Cells(65536, "A").End(xlUp).Row
    Set rngDataTbl = Range(.Cells(1, "A"), .Cells(lngR, "A"))
  End With
  ' 見出し付きで降順ソート
  rngDataTbl.Sort Key1:=rngDataTbl(1, 1), Order1:=xlAscending, Header:=xlYes
  ' 見出しは不要なので、データ範囲を補正
  Set rngDataTbl = rngDataTbl.Offset(1).Resize(rngDataTbl.Rows.Count - 1)
  ' データ範囲を一次元配列に変換
  Buffer = Application.Transpose(rngDataTbl.Value)
  ' 配列から重複データをドロップする
  Call GetUniqueArray(Buffer)
  ' リストボックスにデータセット
  With ListBox1
    .List = Buffer
    .ListIndex = 0
  End With
  Set rngDataTbl = Nothing
  Exit Sub

ERROR_HANDLER:
  MsgBox "ListBox にデータを追加できません.", vbExclamation
End Sub

' 重複のない配列を生成(サブプロシージャ)
Private Sub GetUniqueArray(ByRef Source As Variant)
  
  Dim colTmp As Collection
  Dim aryTmp As Variant
  Dim vntElm As Variant
  Dim i   As Long

  On Error GoTo ERROR_HANDLER

  Set colTmp = New Collection
  ' Collection には同一値を Add できない --> On Error Resume Next
  ' にすると、結果として重複値はカットされる
  On Error Resume Next
  For Each vntElm In Source
    If vntElm <> Empty Then
      colTmp.Add CStr(vntElm), CStr(vntElm)
    End If
  Next vntElm
  On Error GoTo 0
  
  If colTmp.Count = 0 Then
    Exit Sub
  Else
    ' Collection から配列に戻す
    ReDim aryTmp(colTmp.Count - 1)
    For i = 1 To colTmp.Count
      ' 書式化しておく
      aryTmp(i - 1) = Format$(CDate(colTmp.Item(i)), "yyyy/mm/dd")
    Next i
    Source = aryTmp
  End If
  Set colTmp = Nothing
  Exit Sub

ERROR_HANDLER:
  Err.Raise 1000, , "重複のない配列の生成に失敗しました."
End Sub
    • good
    • 0
この回答へのお礼

すばらしい解答をありがとうございました。
自分なりに解釈し、参考にさせて頂きます。
ありがとうございました。

お礼日時:2006/08/10 09:17

こんにちは。

KenKen_SP です。

もとのコードを最大限に活用すればこんな感じ。AdvancedFilter で重複値を
カットするため、作業用に B列 を使いました。

Private Sub UserForm_Initialize()

  Dim i      As Long
  Dim lngR    As Long
  Dim myRng    As Range

  With Worksheets("データ")
    lngR = .Cells(65536, "A").End(xlUp).Row
    Set myRng = Range(.Cells(1, "A"), Cells(lngR, "A"))
    ' 見出し付きでソート
    myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes
    ' 重複のない日付をB列に転記
    .Range("B:B").ClearContents
    myRng.AdvancedFilter Action:=xlFilterCopy, _
               CopyToRange:=Range("B1"), _
               Unique:=True
    ' データ範囲をB列に訂正
    lngR = .Cells(65536, "B").End(xlUp).Row
    Set myRng = Range(.Cells(2, "B"), Cells(lngR, "B"))
  End With
  With ListBox1
    .Clear
    For i = 2 To lngR - 1
      .AddItem myRng.Cells(i, 1).Text
    Next i
  End With
  ListBox1.ListIndex = 0

End Sub
    • good
    • 0

このQ&Aに関連する人気のQ&A

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

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

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

QListBoxにAddItemする際、重複しないようにしたい

 ユーザーフォームで作成するListBoxにAddItemでデータを次々に追加したいのですが、データ自体に重複があるため、単純に順番に追加するとListBoxのデータも重複してしまいます。
 重複を回避する方法はいろいろあるのではないかとは思いますが、ListBoxに追加するデータが既に入っているかどうかを調べる方法はないでしょうか。
 よろしくお願いします。

Aベストアンサー

私は、先日、同じ事象を下記参考URLを参考にして解決しました。

参考URL:http://www3.plala.or.jp/sardonyx/smart/vb/ctrl/5.html

QVBA コンボボックスの重複削除

こんばんわ。
VBAをはじめたばかりで、コンボボックスで困っています。
sheet1にコンボボックスを配置して、sheet2のA列にあるデータ (例) A列
         1
         1
         2
を コンボボックスに
         1
         2
というようにデータを入れたいのですが、どの様にしたらよいのでしょうか?

sheet1.コンボボックス.value=workSheet("sheet2).Range(A1:A3).value とすると1・1・2というようにA列の値がすべて入ってしまいました。
これを1・2というようにコンボボックスに入れたいです。 
よろしくお願いいたします。

Aベストアンサー

こんばんは。一案です。参考にしてください。


Sub Test()
Dim R As Long
Worksheets("Sheet1").ComboBox1.Clear

With Worksheets("Sheet2")
 For R = 1 To .Range("A1").End(xlDown).Row - 1
  If .Range("A" & R) <> .Range("A" & R + 1) Then
   Worksheets("Sheet1").ComboBox1.AddItem .Range("A" & R)
  End If
 Next R
   Worksheets("Sheet1").ComboBox1.AddItem .Range("A" & R)
End With
End Sub

 
以上です。

Qコンボボックスへ降順に表示するには?

Formに貼り付けている ComboBox1 へ
シート(Date_Base)のリストを 降順で表示したいのですが
どのように コードを書けばいいのでしょうか?

Aベストアンサー

こんにちは。

最初に、正しく、Set rng = Range(....) の部分を設定してください。

シート・モジュール

Sub EnterData2Combo()
Dim Ar() As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A10")
 ReDim Ar(rng.Rows.Count - 1)
 For i = 0 To rng.Rows.Count - 1
  Ar(i) = rng.Cells(i + 1).Value
 Next i
 Babble_Sort Ar()
 Me.ComboBox1.List = Ar()
End Sub
Sub Babble_Sort(ByRef Ar())
 Dim u As Long
 Dim i As Long
 Dim j As Long
 Dim t As Variant
 u = UBound(Ar())
 i = LBound(Ar())
 Do While i < u
  j = u
  Do While j > i
   If Ar(j) > Ar(i) Then '降順
    t = Ar(j)
    Ar(j) = Ar(i)
    Ar(i) = t
   End If
   j = j - 1
  Loop
  i = i + 1
 Loop
End Sub

こんにちは。

最初に、正しく、Set rng = Range(....) の部分を設定してください。

シート・モジュール

Sub EnterData2Combo()
Dim Ar() As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A10")
 ReDim Ar(rng.Rows.Count - 1)
 For i = 0 To rng.Rows.Count - 1
  Ar(i) = rng.Cells(i + 1).Value
 Next i
 Babble_Sort Ar()
 Me.ComboBox1.List = Ar()
End Sub
Sub Babble_Sort(ByRef Ar())
 Dim u As Long
 Dim i As Long
 Dim j As Long
 Dim t As Variant...続きを読む

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

Qエクセル VBA ユーザーフォームを閉じる

ユーザーフォームを開く時は
UserForm1.Showですが
閉じる時は?
UserForm1.Close
だとコンパイルエラーになります。
End
にするしかないですか?

Aベストアンサー

Unload Me とか Unload UserForm1 でユーザーフォームを閉じることができます。

Qexcelのリストボックスで選択した項目をアクティブセルに入力方法

もしかしたら既出かもしれませんが・・・
フォームコントロールのリストボックスで入力範囲の指定したリストをリンクするセルをワークシート上にクリックしたセルに入力させる方法はありますか?
もし、不可能でしたら、ActiveXコントロールのリストボックスでも構いません。よろしくお願いいたします。

Aベストアンサー

そのリストボックスの、コードの表示で
Private Sub ListBox1_Click()
ActiveCell = ListBox1.List(ListBox1.ListIndex)
End Sub
と入れるだけ。
コントロールツールボックスのコントロールを、ワークシートに直接
貼り付けた場合。
WEBや解説書で、ListboxとかListindexなど調べましたか。

Q別シートデータからの重複のない入力規則リスト作成

エクセルで、入力規則のリスト作成に関してご教示ください。
別シートにて、以下のようにC列にデータがあります。
データ数は可変です。

A列 B列 C列
No 種別 データ
1 A データA
2 A データA
3 A データA
4 A データB
5 C データC
6 A データB
7 C データB
    :
    :

上記データを使用して、入力規則で、リスト作成をしたいのです。

=OFFSET(シートA!$A$2,0,0,COUNTA(シートA!$A:$A)-1,1)
上記式を名前定義して、リストに設定した場合には、重複したリスト表示が
されてしまします。

名前定義を使ってどう設定すれば、重複をしないリストづくり可能でしょうか。

Aベストアンサー

>別途重複のないリストを作ること(セル上に新たに表を作成)「なし」でリストを作りたい(入力規則に設定したい)

という事は、回答No.2様の方法の様な別シートに重複のないリストを作る方法も駄目だという事でしょうか?
(因みに、別シートにリストを作っても良いのでしたら、マクロなど使わずとも、回答No.1の方法で重複の無いリストを作ってから、E列~G列の全体を切り取り、別シートの適当な列の所に、[切り取ったセルの挿入]で挿入するだけで事足ります)
 もし、別途にリストを作る事が一切駄目だと仰るのでしたら、マクロを使うより他に方法は無い様に思います。

 以下は、別途にリストを作成する事無く、重複の無い入力規則のドロップダウンリストを設定するVBAのマクロの一例です。
 但し、御質問文には、「どのセルに入力規則を設定すれば良いのか」という事に関する情報が御座いませんでしたので、取り敢えずとして、入力規則を設定するセルがどのセルであるのかを、毎回訊いて来る様なマクロとしております。
 それから、シートAのC列のデータが変更されて、入力規則のドロップダウンリストに表示すべき内容が変わった場合であっても、マクロを再起動させない間は、シートAのC列の最新の状態がドロップダウンリストに反映される事はありませんから、シートAのC列のデータを変更する度に、マクロを再起動させる必要があります。(入力規則を設定すべきセルがどのセルであるのか不明なため、仕方がありません)


Sub 重複の無いドロップダウンリスト()

Dim c As Range
Dim a As Variant
Dim LR As Long
Dim l As String

LR = Application.Evaluate("=MAX(IF(COUNT(シートA!C:C),MATCH(9E+307,シートA!C:C ),0),IF(COUNTIF(シートA!C:C,""*?""),MATCH(""*?"",シートA!C:C,-1),0))")
If LR <= Range("C1").Row Then Exit Sub
Cells(2, Rows.Columns.Count).Value = Sheets("シートA").Range("C2").Value
Cells(3, Rows.Columns.Count).Resize(LR - Sheets("シートA").Range("C2").Row).FormulaR1C1 = _
"=R[-1]C&IF(OR(シートA!RC3="""",COUNTIF(シートA!R2C3:R[-1]C3,シートA!RC3)),"""","",""&シートA!RC3)"
l = Cells(LR, Rows.Columns.Count).Value
Columns(Rows.Columns.Count).Clear
On Error GoTo label1
label2:
Set c = Application.InputBox(Title:="入力規則の設定対象", prompt:="入力規則を設定するセル或いはセル範囲を選択して下さい。" & Chr(10) & "  (複数選択可)", Default:=Selection.Address(ReferenceStyle:=xlA1), Type:=8)
c.Select
a = MsgBox("以下のセル" & Chr(10) & Chr(10) & c.Address(ColumnAbsolute:=False, RowAbsolute:=False, ReferenceStyle:=xlA1) & Chr(10) & Chr(10) & "に対して入力規則を設定します。" & Chr(10) & "宜しいですか?" & Chr(10) & Chr(10) & "[はい]⇒入力規則の設定を実行" & Chr(10) & "[いいえ]⇒入力規則を設定するセルの選択をやり直し" & Chr(10) & "[キャンセル]⇒マクロの終了", vbYesNoCancel)
Select Case a
Case Is = 2
GoTo label1
Case Is = 7
GoTo label2
Case Is <> 6
GoTo label1
End Select
With c.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=l
End With

label1:
End Sub

>別途重複のないリストを作ること(セル上に新たに表を作成)「なし」でリストを作りたい(入力規則に設定したい)

という事は、回答No.2様の方法の様な別シートに重複のないリストを作る方法も駄目だという事でしょうか?
(因みに、別シートにリストを作っても良いのでしたら、マクロなど使わずとも、回答No.1の方法で重複の無いリストを作ってから、E列~G列の全体を切り取り、別シートの適当な列の所に、[切り取ったセルの挿入]で挿入するだけで事足ります)
 もし、別途にリストを作る事が一切駄目だと仰る...続きを読む

Qユーザーフォームを表示中にシートの操作をさせるには

ユーザーフォームを表示中にシートの操作をさせる事はできるのでしょうか。
セルへの入力、画面のスクロールなどは、ユーザーフォームからマクロを実行させたり、.hideでユーザーフォームを一時的に隠すなどすればいいのでしょうが、そういう手段をとらないでユーザーフォームを表示中にシートの操作をさせる事はできるのでしょうか。

Aベストアンサー

ユーザフォームの
ShowModalプロパティを
falseにすればよいかと。

Qリストボックスの並び替え

VB.NETについて質問です。
ボタン1をクリックしたら、テキストボックス1に入力した文字を、リストボックス1に登録するとします。
この時、名前、年齢を入力します。
これを、ボタン2、3、をクリックしたら、リストボックスの内容を、名前順、年齢順に並べ替えたいです。
どうしても分かりません。
並べ替えるにはどうしたらいいでしょうか?

Aベストアンサー

下記のコントロールとコードを追加すると実現できます。
他にも方法はあるのですが、自作のコントロールを作る必要があるので、
この方法が簡単だと思います。
前に作っていたものを少し改造したものなのでもしかしたら不具合があるかもしれません。
(エラー処理などは入っていません。
 名前と年齢を一つのテキストで入力したい場合は、
 追加ボタンの処理の箇所で、入力された文字列を分割して設定してください。)

'下記のコントロールをフォームに追加
リストボックスListBox1
テキストボックス(年齢)txtAge
テキストボックス(名前)txtName
ボタン(年齢順)btnSortAge
ボタン(名前順)btnSortName
ボタン(追加)btnAdd
ボタン(削除)btnDel

'------------------------------------------------------
' 下記をフォームの初期処理のコードに追加
' Form1_Load もしくは Public Sub New() の中に追加
'------------------------------------------------------

Call InitListBox()

'------------------------------------------------------
' 下記をフォームのコードに追加
'------------------------------------------------------
Dim mListBoxDtSet As DataSet
Dim mListBoxDtTable As DataTable
Dim mListBoxDtView As DataView

'リストボックス削除処理
Private Function DelListBox(ByVal index As Integer) As Boolean

Dim dtRow() As DataRow
dtRow = mListBoxDtTable.Select("Id = " & index.ToString)
If IsNothing(dtRow(0)) = False Then
mListBoxDtTable.Rows.Remove(dtRow(0))
Return True
Else
Return False
End If

End Function

'リストボックス追加処理(戻り値:追加した項目のIndex="Id")
Private Function AddListBox(ByVal age As Integer, ByVal name As String) As Integer
Dim dtRow As DataRow

dtRow = mListBoxDtTable.NewRow()
dtRow("Age") = age
dtRow("Name") = name
dtRow("DisplayCol") = name & " " & age 'リストボックスへ表示する内容
mListBoxDtTable.Rows.Add(dtRow)

Return CType(dtRow.Item("Id"), Integer)

End Function

'リストボックス初期化処理
Private Sub InitListBox()
'データセット作成
mListBoxDtSet = New DataSet("ListBoxData")
'データテーブル作成
mListBoxDtTable = mListBoxDtSet.Tables.Add("Hito")
Dim pkCol As DataColumn = mListBoxDtTable.Columns.Add("Id", Type.GetType("System.Int32"))
pkCol.AutoIncrement = True
pkCol.AutoIncrementSeed = 1
pkCol.AutoIncrementStep = 1
mListBoxDtTable.Columns.Add("DisplayCol", Type.GetType("System.String"))
mListBoxDtTable.Columns.Add("Age", Type.GetType("System.Int32"))
mListBoxDtTable.Columns.Add("Name", Type.GetType("System.String"))
mListBoxDtTable.PrimaryKey = New DataColumn() {pkCol}
'データビュー作成
mListBoxDtView = New DataView(mListBoxDtSet.Tables("Hito"), "", "", DataViewRowState.CurrentRows)
mListBoxDtView.Sort = "Id"
'リストボックスとデータビューを連結
ListBox1.DataSource = mListBoxDtView
ListBox1.DisplayMember = "DisplayCol"
ListBox1.ValueMember = "Id"

End Sub

'年齢順ボタン_クリックイベントハンドラ
Private Sub btnSortAge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortAge.Click
'降順にしたい場合は"ASC"を"DESC"に変更
mListBoxDtView.Sort = "Age ASC"
End Sub

'名前順ボタン_クリックイベントハンドラ
Private Sub btnSortName_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortName.Click
'降順にしたい場合は"ASC"を"DESC"に変更
mListBoxDtView.Sort = "Name ASC"
End Sub

'追加ボタン_クリックイベントハンドラ
Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click
Call AddListBox(txtAge.Text, txtName.Text)
End Sub

'削除ボタン_クリックイベントハンドラ
Private Sub btnDel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDel.Click
'選択項目存在チェック
If ListBox1.SelectedItems.Count = 0 Then
Exit Sub
End If
'選択項目情報取得
Dim rowId(ListBox1.SelectedItems.Count - 1) As Integer
Dim dtRow As DataRowView
For i As Integer = 0 To ListBox1.SelectedItems.Count - 1
dtRow = CType(ListBox1.SelectedItems(i), DataRowView)
rowId(i) = CType(dtRow("Id"), Integer)
Next
'選択項目該当行削除
For i As Integer = 0 To ListBox1.SelectedItems.Count - 1
Call DelListBox(rowId(i))
Next
End Sub

下記のコントロールとコードを追加すると実現できます。
他にも方法はあるのですが、自作のコントロールを作る必要があるので、
この方法が簡単だと思います。
前に作っていたものを少し改造したものなのでもしかしたら不具合があるかもしれません。
(エラー処理などは入っていません。
 名前と年齢を一つのテキストで入力したい場合は、
 追加ボタンの処理の箇所で、入力された文字列を分割して設定してください。)

'下記のコントロールをフォームに追加
リストボックスListBox1
テキストボックス...続きを読む

Q別のシートから値を取得するとき

Worksheets("シート名").Activate
上記のを行ってから別シートの値を取得するのですが、
この処理を行うと指定したシートへ強制的にとんでしまいます。。。

※イメージ
For ~ To ~
  Worksheets("シートA").Activate
  シートAの値取得
       :
  Worksheets("シートB").Activate
  シートBの値取得
Next

このイメージ処理を行うとものすごい勢いで画面がチカチカします。。。
シートを変えずに他のシートから値を取得する方法はないのでしょうか。
教えてください!

Aベストアンサー

Worksheets("シートA").Range("A1")

みたいな感じでできませんか?


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

人気Q&Aランキング