Excel VBAでアンケート集計をする際にデータが消えてしまう問題の修正方法

前へ 次へ
このQ&Aのポイント
  • Excel VBAを使ってアンケート集計をしたいと思い、プログラムを作成しました。しかし、データを入力する列Kの次の行にデータを入れると、元々存在していたK列のデータが消えてしまいます。
  • データが消えないように修正する方法を教えてください。
  • Excel VBAを使用してアンケート集計を行う際に、データが消えてしまう問題が発生しています。どのように修正すればこれを解決できるでしょうか？お知恵をお貸しください。
回答を見る
  • ベストアンサー

EXCEL　VBA　

Excel　VBAで　アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると　もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば　ちゃんとデータが残ってくれるのでしょうか？ 　誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

列Ｊが１０列目、列Ｋは１１列目。 ＶＢＡ中に"１０"はあるが、"１１"が見当たらない。 もう一度、やりたいことを整理して。

1-29-jin
質問者

お礼

了解しました　ありがとうございます

  1. カテゴリ
  2. [技術者向] コンピューター
  3. データベース
  4. その他(データベース)

関連するQ&A

  • EXCEL　VBA　

    Excel　VBAで　アンケート集計をしたいと思い、プログラムを作ったのですが、J列までは入力がうまくいくのですが、K列にデータを入れて次の行にデータを入れると　もともと存在していたＫれつのデータが消えてしまします。 どう修正すれば　ちゃんとデータが残ってくれるのでしょうか？ 　誰か教えてください Option Explicit Private Sub UserForm_Initialize() Dim チェックボックス As Control With cboBlood .AddItem "A型" .AddItem "B型" .AddItem "O型" .AddItem "AB型" End With cboBlood.ListIndex = -1 txtNo.Value = WorksheetFunction.Max( _ [Database].Resize(, 1)) + 1 txtNo.Enabled = False txtName.Text = "" optMale.Value = True txtAge.Value = 0 For Each チェックボックス In fraOS.Controls チェックボックス.Value = False Next txtName.SetFocus End Sub Private Sub cmdEntry_Click() Dim 行 As Long Dim 確認 As Integer 確認 = MsgBox("データを登録します。" _ & "よろしいですか?", vbYesNo) If 確認 <> vbYes Then Exit Sub 行 = [Database].Rows.Count + 1 [Database].Cells(行 - 1, 1).EntireRow.Insert [Database].Offset(行 - 1).Resize(1).Copy _ [Database].Cells(行 - 1, 1) [Database].Offset(行 - 1).Resize(1).ClearContents [Database].Cells(行, 1) = txtNo.Value [Database].Cells(行, 2) = txtName.Text If optMale.Value = True Then [Database].Cells(行, 3) = "男性" Else [Database].Cells(行, 3) = "女性" End If [Database].Cells(行, 4) = cboBlood.Text [Database].Cells(行, 5) = txtAge.Value If chkWin.Value = True Then _ [Database].Cells(行, 6) = "○" If chkMac.Value = True Then _ [Database].Cells(行, 7) = "○" If chkLinux.Value = True Then _ [Database].Cells(行, 8) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 9) = "○" If chkOther.Value = True Then _ [Database].Cells(行, 10) = "○" Unload frmNew End Sub Private Sub cmdCancel_Click() Unload frmNew End Sub

  • ２つのVBAを組み合わせる方法

    お世話になります、２つのVBAを組み合わせる方法で迷っています。 １つ目が Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, k As Long, myNum As Long If Intersect(Target, Range("C1,B9:B39")) Is Nothing Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target If .Column = 3 Then myNum = WorksheetFunction.Max(Range("B9:B39")) If IsDate(.Value) Then For i = 9 To 39 If Cells(i, "A").Value = "" Then Cells(i, "B").Value = "" Else Cells(i, "B") = myNum + i - 8 End If Next i End If Else i = .Row If .Value = "" Then Range(Cells(i + 1, "B"), Cells(39, "B")).ClearContents Else For k = i + 1 To 39 If Cells(k, "A").Value = "" Then Cells(k, "B").Value = "" Else Cells(k, "B") = Cells(k - 1, "B") + 1 End If Next k End If End If End With Application.EnableEvents = True End Sub です。 ２つめが Private Sub Worksheet_Change(ByVal Target As Range)　 Application.EnableEvents = True If Intersect(Target, Range("R8:R38")) Is Nothing Then Exit Sub Application.EnableEvents = False Range(Cells(Target.Row, 18), Cells(39, 18)).Value = Target.Value Application.EnableEvents = True End Sub です。２つのPrivate Sub Worksheet_Change(ByVal Target As Range)イベントのVBAですが、どのようにして組み合わせれば良いのでしょうか？

  • Excel　VBAフォーム　登録ボタンの作成方法

    いつもお世話になっています。 初めて、Excelのフォームで入力画面を作りました。 複数の項目があって、それを最後に[登録]ボタンをクリックで 表に入れたいのですが、一度にまとめて実行する方法が分かりません。 アドバイスよろしくお願いいたします。 Private Sub cmd_1() Dim i As String If man.Value = True Then ActiveCell = man.Caption End If If woman.Value = True Then ActiveCell = woman.Caption End If ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_2() Dim i As String If man.Value = True Then ActiveCell = Yes.Caption End If If woman.Value = True Then ActiveCell = No.Caption End If ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_downlist() Dim ListNo As Long ListNo = group.ListIndex ActiveCell.Value = group.List(ListNo, i) ActiveCell.Offset(0, 1).Select End Sub Private Sub cmd_comment() ActiveCell = comment.Text ActiveCell.Offset(1, -3).Select End Sub

  • エクセルＶＢＡを教えて下さい

    エクセルの表で －ＡＢ Ｃ Ｄ Ｅ Ｆ １年月－－1801 ２－－－－－－ ３－－－－－－ ４－－－－－－ （－）は空欄でセルＥ１＝１８、Ｆ１＝１とします。 コントロールボックスをつかって Private Sub Command登録_Click() Dim d1 As Long Dim d2 As Long Dim ret As Variant Dim FindValue As String Dim TotalAddress As String If Range("E1").Value = "" Or Range("F1").Value = "" Then MsgBox "該当する場所にデータが入っていません。", vbCritical Exit Sub End If d1 = Range("A65536").End(xlUp).Offset(1).Row d2 = Range("B65536").End(xlUp).Offset(1).Row FindValue = """" & Range("E1").Value & Range("F1").Value & """" TotalAddress = Range("A1").Resize(d1).Address & "&" & Range("B1").Resize(d1).Address ret = Evaluate("MATCH(" & FindValue & "," & TotalAddress & ",0)") If IsError(ret) Then Cells(d1, 1) = Range("E1").Value Cells(d2, 2) = Range("F1").Value Else MsgBox "既に同じ組み合せがあります。", vbInformation End If End Sub というものを作ったのですが、Ｅ１＝１８、Ｆ１＝１及びコマンドボタンを別シートに作成し、上記の表への登録をできるようにしたいのですが、なにかいい方法はありませんか？

  • エクセル　VBA　リストについて

    エクセル　VBA　リストについて ComboBox3が例えばAなら ComboBox5にリストを入れたい 同じBookにSheet”masuta"がありそこに U1　V1　W1　X1 A　　B　C　　D U列の下には”A"があり、Aの項目を入れ込んでいます。 ComboBox３が”A”と表示させた場合 ComboBox５はU列のU３以降の項目が入るようにしたいのですが Set wbMyBook = Workbooks(strMyBookName)エラー表示され 型の一致がしないと表示されます！ このBookの格納はしているつもりなのですが上手く 回避できません教えて下さい。 それと下の記述をどのように変化させれば良いか アドバイスお願いします。 Private Const WBHName = "k2.xls" Private Const SH1Name = "Sheet1" Private Const wsListName = "masuta" Dim lngYcnt_List As Long '使用行を格納 Dim wbMyBook As Workbook 'このブックをセット Dim wsList As Worksheet 'リストシートをセット Dim strMyBookName As String 'このブックの名前を格納 Private Sub ComboBox3_Change() Dim lng As Long '使用するブックとシートをセット Set wbMyBook = Workbooks(strMyBookName) Set wsList = wbMyBook.Worksheets(wsListName) 'リストシートの使用行を格納 lngYcnt_List = wsList.Range("masuta!U1:X1").CurrentRegion.Rows.Count 'コンボボックスComboBox1のクリア・フラグをfalseにする。 ComboBox5.Clear flag = False '同じ数字のもののコンボボックスComboBox1に追加。 For lng = 1 To lngYcnt_List If ComboBox3.Value = wsList.Cells(lng, 21) Then 'ComboBox1,TextBox8,呼吸具体策に表示する。 ComboBox5.AddItem wsList.Cells(lng, 21) End If If ComboBox3.Value = wsList.Cells(lng, 22) Then ComboBox5.AddItem wsList.Cells(lng, 22) End If If ComboBox3.Value = wsList.Cells(lng, 23) Then ComboBox5.AddItem wsList.Cells(lng, 23) '処理を抜けるExit For flag = True End If Next lng End Sub

  • エクセル　VBA　for文について

    再び失礼します。 昨日VBAを始めた初心者です。 1、チェックボタン17個にそれぞれ変数を設定 2、２つだけチェックを入れると仮定して、実行ボタンを押したときに チェックが入っている2つの中で変数の大きいものをMax、小さいものをMinとしてシートに出力したいのですが、”ここ”と書いてあるところに Me("hensuu" & n). hensuu & n など入れてみたのですがエラーになります。 くだらないミスだと思いますがよくわかりません。 どなたかご教授お願いします。 Private Sub CommandButton2_Click() If Check1.Value = True Then hensuu1 = "9" End If If Check2.Value = True Then hensuu2 = "8" End If If Check3.Value = True Then hensuu3 = "7" End If If Check4.Value = True Then hensuu4 = "6" End If If Check5.Value = True Then hensuu5 = "5" End If If Check6.Value = True Then hensuu6 = "4" End If If Check7.Value = True Then hensuu7 = "3" End If If Check8.Value = True Then hensuu8 = "2" End If If Check9.Value = True Then hensuu9 = "1" End If If Check11.Value = True Then hensuu10 = "1/2" End If If Check11.Value = True Then hensuu11 = "1/3" End If If Check12.Value = True Then hensuu12 = "1/4" End If If Check13.Value = True Then hensuu13 = "1/5" End If If Check14.Value = True Then hensuu14 = "1/6" End If If Check15.Value = True Then hensuu15 = "1/7" End If If Check16.Value = True Then hensuu16 = "1/8" End If If Check14.Value = True Then hensuu17 = "1/9" End If Dim n As Long Dim Max As Long Dim Min As Long For n = 1 To 17 If Me("Check" & n).Value = True Then Max = ”ここ” If Me("Check" & n).Value = True Then Exit For Next n For n = Max To 17 If Me("Check" & n).Value = True Then Min = ”ここ” If Me("Check" & n).Value = True Then Exit For Next n Worksheets("Sheet1").Range("A1") = Min Worksheets("Sheet1").Range("B1") = Max MsgBox hensuu End Sub

  • エクセルVBA　VLOOKUPについて

    エクセル　VBA初心者です。 関数でのVLOOKUPをVBAで作りたいのですが、上手くいきません。 あらかじめ、Sheet2の1から300行までに A列　 / B列 商品名 / 商品コード が入力されています。(名前の定義=商品コード) Sheet1にユーザーフォームを利用して、データを書き込んだ後、 B列に商品名が書き込まれると、 A列に商品コードが表示されるようにしたいと考えています。 A列に =IF(B2="","",VLOOKUP(B2,商品コード,2,FALSE)) と入力していたのですが、 VBAでIfを使って出来ないかと考えてみたのですが、 上手くいきませんでした。 Private Sub Worksheet_Change(ByVal Target As Range) Dim sRow As Long Dim sColumn As Long sRow = ActiveCell.Row sColumn = ActiveCell.Column If Cells(sRow, 2).Value = True Then Cells(sRow, 1).Value = WorksheetFunction.VLookup(Cells(sRow2).Value, Worksheets("Sheet2").Range("A1:B300"), 2, False) ElseIf Cells(sRow, 2).Value = " " Then Cells(sRow, 1).Value = " " End If End Sub ご教授いただけないでしょうか？ エクセル2003 WindowsXP

  • Excel VBAでIF～Thenの入れ子がうまくできません。

    いつもお世話になってます。 IF～Then～EndIfにIFを入れていますがうまくいきません。よろしくお願いします。 Private Sub CommandButton10_Click() Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Dim 行 As Long Dim 列 As Long If TextBox33.Value = "" Then MsgBox "使用量を入力してください。" Else If TextBox11 <> "" Then TextBox26 = TextBox33 * TextBox11 / 100 '成分1 End If If TextBox12 <> "" Then TextBox25 = TextBox33 * TextBox12 / 100 '成分2 End If Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("shinki").Activate 最終行 = (Range("B2").End(xlDown).Row) '商品名の行検索 サーチ行 = 0 For i = 2 To 最終行 If ComboBox3.Value = Range("B" & i) Then Workbooks("データ物質試薬管理.xls").Close savechanges:=False '保存しない Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("kongou").Select Range("A65536").End(xlUp).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm11.TextBox16.Value 'CAS Cells(行, 列 + 1) = UserForm11.TextBox21.Value '使用日 Cells(行, 列 + 2) = UserForm11.TextBox29.Value '使用者 Cells(行, 列 + 4) = UserForm11.TextBox26.Value '成分1使用量 Cells(行 + 2, 列) = UserForm11.TextBox18.Value 'CAS Cells(行 + 2, 列 + 1) = UserForm11.TextBox21.Value '使用日 Cells(行 + 2, 列 + 2) = UserForm11.TextBox29.Value '使用者 Cells(行 + 2, 列 + 4) = UserForm11.TextBox24.Value '成分3使用量 Cells(行 + 2, 列 + 5) = UserForm11.TextBox32.Value '種類 Cells(行 + 2, 列 + 6) = UserForm11.TextBox34.Value '単位 Cells(行 + 2, 列 + 7) = UserForm11.ComboBox3.Value '商品名 Workbooks("データ物質試薬管理.xls").Close savechanges:=True 'showhinに在庫管理する Workbooks.Open Filename:=ThisWorkbook.Path & "\データ物質試薬管理.xls" Sheets("showhin").Select Range("A65536").End(xlUp).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column Cells(行, 列) = UserForm11.TextBox2.Value '品名コード Cells(行, 列 + 1) = UserForm11.ComboBox3.Value '商品名 'Cells(行, 列 + 2) = UserForm9.TextBox3.Value '１本の量 'Cells(行, 列 + 3) = UserForm9.TextBox4.Value '本数 Cells(行, 列 + 4) = UserForm11.TextBox34.Value '単位 Cells(行, 列 + 5) = UserForm11.TextBox32.Value '種別 Cells(行, 列 + 6) = UserForm11.TextBox21.Value '使用日 Cells(行, 列 + 7) = UserForm11.TextBox29.Value '使用者名 Cells(行, 列 + 9) = UserForm11.TextBox33.Value '使用量 Workbooks("データ物質試薬管理.xls").Close savechanges:=True MsgBox "登録しました。" End If サーチ行 = i Exit For 'End If Next If サーチ行 = 0 Then MsgBox ComboBox3.Value & "商品は登録されておりません。" & Chr(10) & "「新規商品登録」ボタンから入力してください。" End If End If If TextBox21.Value = "" Then '使用量 MsgBox "使用日を入力してください。" End If ComboBox3.SetFocus End Sub

  • エクセル　マクロ　教えてください。

    sheet１に　（a1=No.　b1=月日　C1=項目　d1=収入　e1=支出　f1=摘要　G1=店名）項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。　本当に良いですか?　", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub

  • Excel VBA　リストボックスの複数列表示の方法について

    すいません、エクセルVBAのユーザーフォームのリストボックスの表示方法について質問があります。 シートのセルに 　　 A列 　 D列　　　G列 1行 りんご　　赤　　　120円 2行　みかん　　黄　　　130円 3行　すいか　　緑 110円 4行　りんご　　赤 160円 . ・・・　　・　　　・・・ . と、50行まで値を入れます。 VBAでユーザーフォームを挿入し、 Private Sub UserForm_Initialize() With ComboBox1 .AddItem "りんご" .AddItem "みかん" .AddItem "すいか" End With End Sub でコンボボックスの値を設定し、次に Private Sub ComboBox1_Change() Dim i As Integer For i = 1 To 50 If Cells(i, 1).Value = ComboBox1.Value Then With ListBox1 .ColumnCount = 3 .AddItem Cells(i, 1) End With End If Next i End Sub このときコンボボックスと同じ値の行について、 リストボックスにA列、D列、G列を表示させるにはどうしたらいいのでしょうか。 例えばコンボボックスで「りんご」を選択したときに、 リストボックスを りんご　赤　120円 りんご　赤　160円 と表示させたいのですが、 .AddItem Cells(i, 1) では一列だけしか表示できません。 Rowsorceを使ってみたりしましたが、どうにもうまく出来ませんでした。 よろしくお願いいたします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する