- ベストアンサー
Active BasicでGOTOのジャンプ先が不正となる問題
magton123の回答
- magton123
- ベストアンサー率33% (1/3)
ActiveBasicは知りませんが、意図するgotoの飛び先は Ha=Ha+0 あたりの行ですか？ もしやテキストの１０４行目と行番号としての１０４を 混同されているのでは？と思うのですが。
関連するQ&A
- 日付入力マクロ
On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If Intersect(Target, Range("A4:A600,E4:E600,J4:J600")) Is Nothing Then Exit Sub 'A列のみを対象 最初につなげるところ ActiveSheet.Unprotect flg = 1 For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが 数字 且 整数 且 101以上 且 991231以下 の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。 変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") ActiveSheet.Protect End If End If End With Next End Sub 上記のマクロで20090731と入力すると平成21年7月31日と表示されます。 210731を入力して平成21年7月31日と表示されるようにすることは可能ですか？
- ベストアンサー
- オフィス系ソフト
- マクロ シートの保護
下記のマクロにおいて、A列以外のセルに文字なり数字なりを書くと、シートの保護が解除されてしまいます。 また、保護が解除されている状態でA列に20091010と入力してマクロを実行させるとシートが保護されます。 ずーっと保護された状態を続けるようにするにはどのようにすればよいですか？ Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim r As Range Dim flg As Long flg = 0 If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect flg = 1 End If If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub 'A列のみを対象 最初につなげるところ For Each r In Target Dim a As Long Dim b As String With r If Not .NumberFormatLocal = "ge.m.d" Or .Value = "" Then .NumberFormatLocal = "G/標準" 'セルの書式設定がH00.m.d形式だったら標準に戻す 'セルが 数字 且 整数 且 101以上 且 991231以下 の場合 If IsNumeric(.Value) And Int(.Value) = .Value And .Value >= 19010101 And .Value <= 20991231 Then b = Left(.Value, 4) & "/" & Mid(.Value, 5, 2) & "/" & Right(.Value, 2) If IsDate(b) Then 'もしbがDateの形なら .Value = CDate(b) 'データ型を日付にする 'ここにつなげる。 変数はtmpからbに直す .NumberFormatLocal = "ggg" & _ IIf(Format(b, "e") > 9, "e年", "_0e年") & _ IIf(Month(b) > 9, "m月", "_1m月") & _ IIf(Day(b) > 9, "d日", "_1d日") If ActiveSheet.UnprotectContents = True Then ActiveSheet.Protect flg = 1 End If End If End If End With Next If flg = 1 Then ActiveSheet.Protect End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ初心者です。画像一括挿入について
初めてマクロを使っております。 以下ネットで拾ってきましたコードなのですが、 行いたいのは (1)挿入するセルを選択（複数可） (2)画像を一括選択 (3)縦横比率を固定して挿入：横か縦の長さは自分で設定 ※今のコードですと(3)で比率の固定ができず、伸びた画像が挿入されてしまいます これを可能にするには、一体どこをどう変えたらよいのでしょうか。 慣れない画像編集に悪戦苦闘しております。 どなたかご教授いただけますと幸いです。 どうぞよろしくお願い致します。 Sub try() Dim a As Range Dim cc As Range Dim W As Single Dim H As Single Dim mx As Long Dim fi As Long Dim i As Long Dim pkfile On Error GoTo extLine With Application Set a = .InputBox("画像挿入するセル選択" & vbLf & _ "複数選択可", _ "複数画像の一括挿入（セル選択）", _ Selection.Address, _ Type:=8) pkfile = .GetOpenFilename("すべての図" & _ "(*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _ "*.jpe;*.png;*.bmp;*.gif)," & _ "*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;" & _ "*.jpe;*.png;*.bmp;*.gif", 2, _ "挿入する図の選択（複数選択可）", , True) If Not IsArray(pkfile) Then MsgBox "ファイルが指定されていません", , _ "複数画像の一括挿入" GoTo extLine End If W = .InputBox("ヨコ", Type:=1) H = .InputBox("タテ", Type:=1) .ScreenUpdating = False End With mx = UBound(pkfile) fi = 1 For Each cc In a If cc.Address = cc.MergeArea.Item(1).Address Then Call picIns(cc, pkfile(fi), W, H) fi = fi + 1 If fi > mx Then Set cc = Nothing Exit For End If End If Next For i = fi To mx Set a = a(a.Rows.Count, 1).Offset(1) Call picIns(a, pkfile(i), W, H) Next extLine: Set a = Nothing Application.ScreenUpdating = False With err() If .Number <> 0 Then MsgBox .Number & ":" & .Description End With End Sub Sub picIns(ByVal r As Range, _ ByVal s As String, _ ByVal W As Single, _ ByVal H As Single) With ActiveSheet.Pictures.Insert(s).ShapeRange If (W > 0) And (H > 0) Then .LockAspectRatio = msoFalse .Width = W .Height = H ElseIf W > 0 Then .Width = W ElseIf H > 0 Then .Height = H End If .Left = r.Left .Top = r.Top End With End Sub
- ベストアンサー
- Excel（エクセル）
- ユーザー定義関数の構文がわからない
以下のコードがあるのですが、コメントがなくて意味がよくわかりません。k = p(1),n = Application.Count(p),t = Sgn(position)というあたりがいきなり見たことのない構文で戸惑ってます。 インターネットでも調べようがありませんでした。 どなたか下のコードにコメントを入れてくれませんでしょうか？ちなみに株式売買のシミュレーション用の関数です。 Function Positioning(position As Single, x As Single, y As Single, p As Range) Dim k As Single, t As Single, r As Single Dim n As Integer, i As Integer If position = 0 Then Positioning = "": Exit Function k = p(1) n = Application.Count(p) t = Sgn(position) If t > 0 Then l = Abs(x): m = -Abs(y) Else l = Abs(y): m = -Abs(x) End If For i = 2 To n r = (p(i) / k - 1) * t If r >= l Or r <= m Then t = 0: Exit For Next If t = 0 Then Positioning = r Else Positioning = "ポジションは解消されていません" End If End Function
- ベストアンサー
- オフィス系ソフト
- VisualBasic compile erroｒ
Sub Macro1r1() Dim r As Long, rr As Long Dim c As Long, cc As Long Dim w As Long, ww As Long Dim stopC As Long stopC = Range("IV1").End(xlToLeft).Column Range(Range("E1"), Cells(1, stopC)).DataSeries rowcol:=xlRows, Type:=xlDataSeriesLinear, Date:=xlDay, Trend:=True For r = 2 To Range("A65536").End(xlUp).Row Cells(r, "B").Resize(1, 3).ClearContents w = 0 For c = 5 To stopC If Cells(r, c).Interior.ColorIndex <> xlNone And Cells(r, c).Interior.ColorIndex <> xlAutomatic Then Cells(r, "B") = Cells(1, c).Value For cc = c To stopC If Cells(r, cc).Interior.ColorIndex = xlNone Or Cells(r, cc).Interior.ColorIndex = xlAutomatic Then Exit For End If w = w + 1 Next cc If cc = stopC Then Cells(r, "C") = Cells(1, cc - 1).Value + 5 Else For rr = cc To stopC If Cells(r, rr).Interior.ColorIndex <> xlNone And Cells(r, rr).Interior.ColorIndex <> xlAutomatic Then For ww = rr To stopC If Cells(r, ww).Interior.ColorIndex = xlNone Or Cells(r, ww).Interior.ColorIndex = xlAutomatic Then Exit For End If w = w + 1 Next ww Next rr <------------------------- 次のerrorメッセ-ジ next without for が表示される。 Cells(r, "C") = Cells(1, rr - 1).Value + 5 End If Cells(r, "D") = w * 7 Exit For End If Next c Next r End Sub
- 締切済み
- その他(業務ソフトウェア)
- 下記の式の意味が解りません、どなたか解る方がいらっしゃれば訳していただ
下記の式の意味が解りません、どなたか解る方がいらっしゃれば訳していただけると大変ありがたいです。 当方、初心者なので宜しくお願い致します。 Private Sub CommandButton1_Click() Dim WCnt As Long Dim WIdx As Long Dim WChk As Integer WIdx = 2 WChk = 0 Do While Not WIdx > 65535 If Cells(WIdx, 4) = 1 And Cells(WIdx, 6) = 1 Then WChk = 1 ElseIf Cells(WIdx, 4) = "" And Cells(WIdx, 6) = 1 Then WChk = 0 End If If WChk = 1 Then Cells(WIdx, 3) = 5 End If WIdx = WIdx + 1 Loop Range("C2").Select End Sub Private Sub CommandButton2_Click() Selection.AutoFilter Field:=1 Range("C2:G65536").ClearContents Range("G2").Select End Sub
- ベストアンサー
- その他([技術者向] コンピューター)
- この構文を解説して欲しい
Private Sub 問題印刷_V_Click() Dim ID_N(2000) As Long '問題ID Dim ID_F(2000) As Boolean '選択済みフラグ Dim ID_P(20) As Integer '選択された問題 Dim I As Integer Dim MF As Boolean '選択マッチング中 Dim CT As Integer 'データカウンタ Dim MAX_V As Integer '問題数 Dim S_N As Integer '選択ID Dim DbsCurrent As Database, rstEmployees As Recordset For I = 1 To 2000 ID_F(I) = False Next Set DbsCurrent = CurrentDb Set rstEmployees = DbsCurrent.OpenRecordset("ST_算数計算テスト", dbOpenTable) rstEmployees.Index = "選択キー" '学年＋階級＋階級区分＋レベル rstEmployees.MoveFirst '最初のレコードに移動 MF = False 'マッチングフラグは、最初は偽 CT = 0 Do If rstEmployees.EOF Then Exit Do 'レコード終了 If rstEmployees!学年 = 学年_V And rstEmployees!階級 = 階級_V And rstEmployees!階級区分 = 段_V And rstEmployees!レベル = レベル_V Then MF = True CT = CT + 1 ID_N(CT) = rstEmployees!ID Else If MF = True Then Exit Do End If rstEmployees.MoveNext Loop rstEmployees.Close If CT = 0 Then MsgBox "問題がありませんでした", 0, "問題未登録エラー": Exit Sub If [5_V] Then MAX_V = 5 If [10_V] Then MAX_V = 10 If [20_V] Then MAX_V = 20
- 締切済み
- Visual Basic
- エクセルVBAで、特定の数字になる組み合わせを知りたいのですが・・・
A.5380、B.4730、C.3310、D.2840、E.2360、F.1890、G.1420、H.940 以上８種類の数字を組み合わせて、合計13010ちょうどになる組み合わせをすべて知りたいです。８種類の数字は、同じものを何度組み合わせても構いません。 例えば、A+A+B=○のようにです。 色々自分なりに調べたところ、ソルバーで試してみましたが、組み合わせの数字が複雑な為か、解答はでませんでした。 また、VBAを使用して以下のような例が掲載されていたので試してみましたが、オーバーフローしてしまって答えがでません。 VBAがまったくの初心者のため、どのようにしたら問題が解消されるのかわかりません。 どなたか教えていただけませんでしょうか。お願いします。 ' knapsack総当たり ' 目標値と一致する物をすべて求める ' 'by S. Tada Const N = 8 ' データの数 Dim wa(N) As Long Sub knap_main() Dim w As Long, wmax As Long Dim i As Integer, j As Long, k As Integer Dim y1 As Integer, y2 As Integer Dim b As Long y1 = 1 ' A1:Anにデータを入れておく y2 = y1 + 1 ' B列以降が結果 For i = 1 To N wa(i) = Cells(i, y1).Value Next wmax = Cells(45, y1).Value ' A45に目標値を入れておく For j = 1 To 2 ^ N - 1 w = 0 b = 1 For k = 1 To N If j And b Then w = w + wa(k) b = b + b Next If w = wmax Then b = 1 For k = 1 To N If j And b Then Cells(k, y2).Value = wa(k) b = b + b Next y2 = y2 + 1 End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 構文の解説をつけてください。
sub macro1() dim a as variant dim h as range dim r as long dim w0 as worksheet set w0 = activesheet worksheets.add after:=w0 r = 1 range("A1:G1") = array("苗字","名前","住所","TEL","〒","好きなスポーツ","性別") on error resume next for each h in w0.range("A1:A" & w0.range("A65536").end(xlup).row) if h <> "" then a = split(replace(application.trim(replace(replace(h, " "," "),"：",":")),": ",":"), " ") r = r + 1 cells(r, "A") = split(a(0), ":")(1) cells(r, "B") = split(a(1), ":")(1) cells(r, "C") = split(a(2), ":")(1) cells(r, "D") = split(a(3), ":")(1) cells(r, "E") = split(a(4), ":")(1) cells(r, "F") = a(5) cells(r, "G") = a(6) end if next end sub
- ベストアンサー
- Visual Basic
- VBA(売り、買い)
以下のようにある条件で買いと売りのサインを求めたいのですが、買いのあとは必ず売りで、売りのあとは必ず買いにするにはどうしたらいいでしょうか？(買い増ししない) （例、２日に買いの条件になったので買いで、５日も買いの条件になったけれど前回（２日）が買いだったのでなにもしない。８日に売りの条件が出たので売り。のような） Dim i As long,a As Long,b As Long For i = 18 To 305 If ActiveSheet.Cells(i - 1, 4) > 20 And ActiveSheet.Cells(i, 4) < 20 Then a = "買い" If ActiveSheet.Cells(u(i - 1), 6) = "買い"Then ActiveSheet.Cells(i, 6) = a End If If ActiveSheet.Cells(i - 1, 4) < 80 And ActiveSheet.Cells(i, 4) > 80 Then b = "売り" ActiveSheet.Cells(i, 6) = b End If Next
- ベストアンサー
- Visual Basic
お礼
回答ありがとうございます。 ご指摘どおり、混同していました。 無事に解決いたしました。 ありがとうございます。