目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
2 / 14 ページ ←次へ | 前へ→

【271】inputboxで入力した数値が正しく反映されな...
Excel  hirobon E-MAIL  - 11/3/6(日) 23:35 -

引用なし
パスワード
   Inputboxでレートを入力し、該当セルに反映させたいのですが、なぜか下記複数インプットボックスがある中で、"a"と、"g"のみなぜか小数点が切り上げされてしまいます。(例) inputobox= \81.135⇒セル=\82.000-など

該当セル確認しましたが、他のセルの書式と全く同じで、なにが原因が検討がつきません.... この件解決策お分かりの方いらっしゃいましたら、お教えいただけますでしょうか???

よろしくお願い致します。

***下記VBA内容載せておきます***
///////////////////////////////////////////////////////////////////////
Sub 3.Aレート記入()

Dim i As Integer
Dim a As Integer

a = Application.InputBox(prompt:="1月レートを入力してください", Type:=1)
b = Application.InputBox(prompt:="2月レートを入力してください", Type:=1)
c = Application.InputBox(prompt:="3月レートを入力してください", Type:=1)
d = Application.InputBox(prompt:="4月レートを入力してください", Type:=1)
e = Application.InputBox(prompt:="5月レートを入力してください", Type:=1)
f = Application.InputBox(prompt:="6月レートを入力してください", Type:=1)
g = Application.InputBox(prompt:="7月レートを入力してください", Type:=1)
h = Application.InputBox(prompt:="8月レートを入力してください", Type:=1)
i = Application.InputBox(prompt:="9月レートを入力してください", Type:=1)
j = Application.InputBox(prompt:="10月レートを入力してください", Type:=1)
k = Application.InputBox(prompt:="11月レートを入力してください", Type:=1)
l = Application.InputBox(prompt:="12月レートを入力してください", Type:=1)

Worksheets("RegionPrice貼り付けシート").Cells(1, 9) = a
Worksheets("RegionPrice貼り付けシート").Cells(1, 11) = b
Worksheets("RegionPrice貼り付けシート").Cells(1, 13) = c
Worksheets("RegionPrice貼り付けシート").Cells(1, 15) = d
Worksheets("RegionPrice貼り付けシート").Cells(1, 17) = e
Worksheets("RegionPrice貼り付けシート").Cells(1, 19) = f
Worksheets("RegionPrice貼り付けシート").Cells(1, 21) = g
Worksheets("RegionPrice貼り付けシート").Cells(1, 23) = h
Worksheets("RegionPrice貼り付けシート").Cells(1, 25) = i
Worksheets("RegionPrice貼り付けシート").Cells(1, 27) = j
Worksheets("RegionPrice貼り付けシート").Cells(1, 29) = k
Worksheets("RegionPrice貼り付けシート").Cells(1, 31) = l

End Sub
//////////////////////////////////////////////////////////////
・ツリー全体表示

【270】動かない原因2.
全般  Jaka  - 11/3/2(水) 15:43 -

引用なし
パスワード
   ExlApp.Run ("'" & OPFL & "'!Auto_Open") 'Auto_Openの場合実行
                     ↑
  Auto_Open")の後のスペースもタブに返還されているから。
・ツリー全体表示

【269】ワードの場合
全般  Jaka  - 11/3/2(水) 11:27 -

引用なし
パスワード
   ワードの場合はね。
ってほとんど変わってない。
掲示板上で、半角スペースがTabに返還されているところは同じ。
修正が必要。

Dim WsArg,WdApp

Set WsArg = WScript.Arguments
If WsArg.Count = 0 Then
  WScript.Echo "このVbsファイルにWordファイルをドラッグ&ドロップしてください。"
  Wscript.Quit
End If

'起動しているワード(アプリ)があるかチェック
On Error Resume Next
Set WdApp = GetObject(, "Word.Application" )
If WdApp Is Nothing Then
  Set WdApp = CreateObject("Word.Application")
End If
On Error Goto 0

WdApp.Visible = True
WdApp.Documents.Open WsArg(0)
CreateObject("WScript.Shell").AppActivate WdApp.Caption
WdApp.WindowState = 0
Set WdApp = Nothing
Set WsArg = Nothing
Wscript.Quit
・ツリー全体表示

【268】VBSファイルにxlsファイルをドラッグ&ドロ...
Excel  Jaka  - 11/3/1(火) 17:18 -

引用なし
パスワード
   下記コードが書かれたVBSファイルにエクセルブックをドラッグ&ドロップすると
エクセルが起動してファイルを開いてくれます。
ただ、下記コードをメモ帳にコピペしても動かないかも。
改行コードの違いか文字コードの違いか解らないけど、以前ここにアップして
試した時は動いてくれなかった。

原因。
>  MsgBox "このVbsファイルに画像ファイルをドラッグ&ドロップしてください。",

この辺など他、半角スペースがタブに返還されているから...。
このタブを消すか半角スペースに直せば動きます。


Dim WsArg,ExlApp

Set WsArg = WScript.Arguments
If WsArg.Count = 0 Then
MsgBox "このVbsファイルにエクセルファイルをドラッグ&ドロップしてください。", vbInformation,"Wクリックエラー。"
Wscript.Quit
End If

'エクセルが起動しているかチェック。
On Error Resume Next
Set ExlApp = GetObject(, "Excel.Application" )
If ExlApp Is Nothing Then
'MsgBox "エクセルが起動していないようなので中止。", vbInformation,"エクセル起動エラー"
'Wscript.Quit
'↓エクセルが起動していなかった場合、起動させたい時。
Set ExlApp = CreateObject("Excel.Application")
End If
On Error Goto 0

OPFL = WsArg(0)
ExlApp.Visible = True
ExlApp.WorkBooks.Open OPFL

CreateObject("WScript.Shell").AppActivate ExlApp.Caption
ExlApp.WindowState = -4143

On Error Resume Next
ExlApp.Run ("'" & OPFL & "'!Auto_Open") 'Auto_Openの場合実行
On Error Goto 0

Set ExlApp = Nothing
・ツリー全体表示

【267】表に位置について。
Excel  Jaka  - 11/2/14(月) 16:59 -

引用なし
パスワード
   上記祝祭日表の位置が気に食わなかったら、1度下記セルに貼り付けてから、
列や行を削除するなり、移動させれば良いです。
参照先も自動で変更されます。

B1
B4〜B29
C4〜C29
・ツリー全体表示

【265】42歳のオジイさんですww
Access  ヨシカズ  - 10/3/25(木) 7:25 -

引用なし
パスワード
   俺みたいなオッサンのイチモツでも、喜んでくれる女性っているもんだな。
SEXの練習相手になっただけで6万円も頂いちゃったよ(^^)
・ツリー全体表示

【264】Re:ちょっと気になる現象6 Shapeオブジェ...
Excel  ichinose  - 10/2/11(木) 20:22 -

引用なし
パスワード
   >アクティブシートに二つの黒く塗りつぶされた見た目はまったく同じの
>オートシェイプの円があります。
>
>以下のような塗りつぶしの色が黒だったら、削除する というコードを実行したところ
>
> Sub test1()
>  Dim c As Shape
>  For Each c In ActiveSheet.Shapes
>    If c.Fill.ForeColor.SchemeColor = 8 Then c.Delete
>   '---------------------------------
>  Next c
> End Sub

上記コードのエラーは、以下のコードで作成された二つのオートシェイプの円に対して
実行すると、発生します。

'=========================================================
Sub サンプル作成()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.SchemeColor = 8
  End With
  With ActiveSheet.Shapes.AddShape(msoShapeOval, rc.Left, rc.Top, rc.Width, rc.Width)
    .Fill.ForeColor.RGB = RGB(0, 0, 0)
  End With
End Sub

同じ黒でもSchemeColorで設定した円とRGB で設定した円、test1は、
RGBで設定した円に対してエラーが発生します。


サンプル作成で作成した円は、以下のコード(test2)だと正常に二つとも削除してくれます。

Sub test2()
  Dim c As Shape
  For Each c In ActiveSheet.Shapes
    If c.Fill.ForeColor.RGB = 0 Then c.Delete
  Next c
End Sub


又、DrawingobjectsのInterior.ColorやColorindexで判断すると
どちらでも(test3 は、Colorindexで判断、test4は、RGBで判断)削除してくれます。

'======================================================
Sub test3()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.ColorIndex = 1 Then c.Delete
  Next c
End Sub
'======================================================
Sub test4()
  Dim c As Object
  For Each c In ActiveSheet.DrawingObjects
    If c.Interior.Color = 0 Then c.Delete
  Next c
End Sub

こんなところでも古いオブジェクトのほうが安定しています。


ShapeのFill.ForeColor.RGB だと微妙な色の設定ができることは
認めますけどね!!


Sub サンプル作成3()
  Dim ra As Range
  Dim rc As Range
  Set ra = Range("b2")
  Set rc = Range("d2")
  With ActiveSheet.Shapes.AddShape(msoShapeOval, ra.Left, ra.Top, ra.Width, ra.Width)
    .Fill.ForeColor.RGB = RGB(220, 105, 235)
  End With
  With ActiveSheet.Ovals.Add(rc.Left, rc.Top, rc.Width, rc.Width)
    .Interior.Color = RGB(220, 105, 235)
  End With
End Sub
・ツリー全体表示

【263】ちょっと気になる現象6 Shapeオブジェクト...
Excel  ichinose  - 10/2/11(木) 19:21 -

引用なし
パスワード
   アクティブシートに二つの黒く塗りつぶされた見た目はまったく同じの
オートシェイプの円があります。

以下のような塗りつぶしの色が黒だったら、削除する というコードを実行したところ

Sub test1()
  Dim c As Shape
  For Each c In ActiveSheet.Shapes
    If c.Fill.ForeColor.SchemeColor = 8 Then c.Delete
   '---------------------------------
  Next c
End Sub

一つの円は、正常に削除されましたが、もう一つの円のでは、
「実行時エラー 70 書き込みできません。」というエラーが発生し、 
上記の----の部分が黄色に塗りつぶされました。
 

どんな原因が考えられるでしょうか?
・ツリー全体表示

【262】Re:ユーザー定義型は定義されていません の...
全般  Jaka  - 10/1/27(水) 11:04 -

引用なし
パスワード
   上の方に書いてある↓をよく読んでください。

●「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

>  Dim ws As worksheeet
           ↑
          ???
・ツリー全体表示

【261】ユーザー定義型は定義されていません の対処
Excel  KN  - 10/1/27(水) 10:49 -

引用なし
パスワード
   以下の、マクロを書いたのですが、いろいろなところで、「ユーザー定義型は定義されていません」と表示されてしまい、そもそもかいたものがちゃんと動くかどうかも検証できません。

全くの初心者ゆえこのような漠然とした質問が許されるとも思ってはおりませんが、まったくどうしたらいいかわからず、幼稚な質問をあげることお許しください。

アドバイスをいただければ幸いです。よろしくお願いします。

Sub makingcollection()
'【格納パート】
'とりあえず全てのシートの注文番号がついているものを配列に、
'注文内容、取引先、納期、金額の順に格納する


  Dim vList() As String
  Dim c As Long
  Dim d As Long
  Dim m As Long
  Dim ws As worksheeet
  Dim chck As String
  c = 0
  
For Each ws In Worksheet
  m = ws.Range("B65536").End(xlUp).Value
  For d = 16 To m
    ws.Range("b" & d).Value = chck
    If chck <> "" And Left(chck, 1) <> "(" Then '空白かカッコで始まる場合無視
      ReDim Preserve st(c)
      vList(0, c) = ws.Range("B" & d).Value
      vList(1, c) = ws.Range("C" & d).Value
      vList(2, c) = ws.Range("D" & d).Value
      vList(3, c) = ws.Range("E" & d).Value
      vList(4, c) = ws.Range("G" & d).Value
      c = c + 1
    End If
  Next

Next

'【出力パート】
'フォーマットつくり
  Worksheets.Add.Name = "総括"
  
  Range("A1").Value = "注文番号"
  Range("B1").Value = "注文内容"
  Range("C1").Value = "取引先名称"
  Range("D1").Value = "納期"
  Range("E1").Value = "発注金額"

'出力
  Dim cx As Long
  
  For cx = LBound(st, 2) To UBound(st, 2)
    Range("A" & cx + 1).Value = vList(0, cx)
    Range("B" & cx + 1).Value = vList(1, cx)
    Range("C" & cx + 1).Value = vList(2, cx)
    Range("D" & cx + 1).Value = vList(3, cx)
    Range("E" & cx + 1).Value = vList(4, cx)
  Next
  
End Sub
・ツリー全体表示

【260】Re:オートフィルタについて
Excel  ponpon  - 10/1/8(金) 13:45 -

引用なし
パスワード
   いっぱいミスがありました。

Sub test()
 Dim A()
 Dim i As Long
 Dim x As Long
With Sheets("Sheet1")
  For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
 
    If Val(Right(.Cells(i, "A").Value, 1)) Mod 2 = 0 Then
     ReDim Preserve A(x)
     A(x) = .Cells(i, "A").Value
     x = x + 1
    End If
  Next
End With
With Sheets("Sheet2")
   .Range("A1").Resize(UBound(A()) + 1).Value = Application.Transpose(A())
End With
End Sub
・ツリー全体表示

【259】Re:オートフィルタについて
Excel  mm  - 10/1/8(金) 12:45 -

引用なし
パスワード
   ▼ponpon さん:

あーーすみません
気づかなかったです
質問はここでは禁止だったんですね。

申し訳ございませんでした

でも、アドバイスありがとうございます

解読してみます
・ツリー全体表示

【258】Re:オートフィルタについて
Excel  ponpon  - 10/1/8(金) 11:34 -

引用なし
パスワード
   ここでは、質問はできませんので
EXCEL質問箱の方へどうぞ。

オートフィルタでは、私の力ではできませんが、
別シートに書き出すなら
こんな感じで・・

Sub test()
 Dim A()
 Dim i As Long
 Dim x As Long
With Sheets("Sheet1")
  For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
   
    If Val(Right(.Cells(i, "A").Value, 1)) Mod 2 = 0 Then
     ReDim Preserve A(i)
     A(j) = .Cells(i, "A").Value
     j = j + 1
    End If
  Next
End With
With Sheets("Sheet2")
   .Range("A1").Resize(UBound(A()) - 1).Value = Application.Transpose(A())
End With
End Sub
・ツリー全体表示

【257】オートフィルタについて
Excel  mm  - 10/1/8(金) 9:02 -

引用なし
パスワード
   どうしてもわからなくて投稿しました

オートフィルタを使用して、末尾が偶数のものだけを抽出する方法ってあるんでしょうか?

A列
12345-100
4568-205
42563-526
41223-100
45612-705
456789123

上記のようなリストの末尾が偶数のものを(又は奇数のみ)、フィルタで抽出したいと思ってます

どうか、アドバイスお願いします
・ツリー全体表示

【255】Re:良く解らないSpecialCells
Excel  ponpon  - 09/12/5(土) 22:17 -

引用なし
パスワード
   2003でも確認できました。ので報告します。
・ツリー全体表示

【253】良く解らないSpecialCells
Excel  Jaka  - 09/12/3(木) 11:03 -

引用なし
パスワード
   ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=43413;id=excel
ここで、SpecialCellsの限界について、問いただしてみましたが
それ以外にも不可解なことがあるので一応掲載してみます。


例えば、下記模擬データ作成でデータ作成後、良く解らないSpcelを実行してみると、
何でこうなるの?
と、思う所があります。
範囲が複雑だとうまく行かない。
って事で、落ち着きそうですが。

by 97 or 2000 or 2002
(現在97が無いので下記状態で試してませんが、97の時に解った不具合なので、97も含むとしています。)


Sub 模擬データ作成()
Range("A1").Value = 10
For i = 1 To 12
  Range("A" & i + 1).Formula = "=A" & i & "+10"
Next
Range("A14:A23").Value = 1
Range("A24:A26").Formula = "=2*2"
Range("B1:B6").Value = 60
Range("B7:B10").Formula = "=1+10"
Range("B11:E19").Value = 100
Range("B20:G21").Formula = "=1+4"
Range("B22:G23").Value = 77
Range("D24:G24").Value = 77
Range("A24:C24").Formula = "=2*2"
Range("A25:I25").Formula = "=2*2"
Range("A26:C26").Formula = "=ADDRESS(ROW(),COLUMN(),4)"
Range("A28:D29").Formula = "=ADDRESS(ROW(),COLUMN(),4)"
Range("A31:C31").Formula = "=ADDRESS(ROW(),COLUMN(),4)"
Range("C1:D10").Formula = "=45"
Range("E1:G10").Value = 80
Range("G1").Formula = "=8/2"
Range("F11:F17").Formula = "=2*3"
Range("F18:F19").Value = 100
Range("G11:G19").Value = 100
Range("H1:H5,H21:H24").Value = 5
Range("H6:H8,H12:H20").Value = "ff"
For i = 1 To 24
  Range("I" & i).Formula = "=SUM(F" & i & ":H" & i & ")"
Next
Range("A2:A13,B7:B10,C1:D10,G1,F11:F17,B20:G21,A24:C26,D25:I25,A28:D29,A31:C31" _
    ).Interior.ColorIndex = 6
End Sub

Sub 良く解らないSpcel()
With ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
  .Value = .Value
End With
End Sub
・ツリー全体表示

【251】Re:郵便番号から住所を表示させたい
全般  Jaka  - 09/11/19(木) 12:50 -

引用なし
パスワード
   ここは質問する場所じゃないから、ここに書いても
ほとんど返答される事はありません。
質問箱の方で、質問してください。
・ツリー全体表示

【250】郵便番号から住所を表示させたい
Excel  NK  - 09/11/16(月) 10:46 -

引用なし
パスワード
   ExcelVBAのユーザーフォームフォームのtextbox1に郵便番号を入力して、郵便番号変換ウイザードを利用して、Textbox2に住所を表示させたいのですが、どのようなプログラムになるのでしょうか。お教え下さい。
・ツリー全体表示

【249】VBエディタ上でのコメント&コメントブロ...
Excel  Jaka  - 09/11/6(金) 14:28 -

引用なし
パスワード
   このネタは、OfficeTanakaさんのところで見たのか、
日経PCで見たのか覚えてませんが、便利なので...。(思いつきで記載)

表示 → ツールバー → ユーザー設定
で、ショートカット メニューにチェックして、ショートカット メニューのツールバーを表示。

ユーザー設定のコマンドタブを選択。
編集の中に「コメントブロック、非コメントブロック」のボタンがあるので、
つまんで、先ほど表示させたショートカットメニューバーの
コードウィンドウ → コードエディタウィンドウ と、たどって好きな位置にドロップダウン。

これで、VBエディタ上の右クリックで、
コメントブロック、非コメントブロックが楽にできるようになります。
・ツリー全体表示

【248】Re:ちょっと気になる現象5 シートモジュー...
Excel  ichinose  - 09/11/4(水) 8:18 -

引用なし
パスワード
   >'==============================================================
>Sub test2()
>  Dim ws As Worksheet
>  Set ws = Worksheets("sheet1")
>  'ws.変数 = "bbb"
>  'MsgBox ws.変数
>End Sub

Worksheetというクラスには、変数というメンバないので
コンパイルエラーが発生する。

又、Object型にすれば、メンバまでのチェックが出来ないの
コンパイルエラーにならない。

という道理はわかりますが、シートオブジェクトがカスタマイズ可能な仕様だと言うことは、念頭になかったのでしょうか?

そこでwsの変数の型をもっと詳細な型であるSheet1にすると、

Sub test4()
  Dim ws As Sheet1
  Set ws = Worksheets("sheet1")
  ws.変数 = "ddd"
  MsgBox ws.変数
End Sub

見事に作動し、これで道理も通ると納得したのですが・・・・。


似たようなことをThisworkbookでやってみると・・・・、

新規ブックにて

ThisWorkBookのモジュールに
Option Explicit

Public 変数 As String
とこれだけ


標準モジュール

'==============================================================
Option Explicit
'==================================
Sub test5()
  Dim nm As String
  nm = ThisWorkbook.Name
  Workbooks(nm).変数 = "aaa"
  MsgBox Workbooks(nm).変数
End Sub
'==================================
Sub test6()
  Dim nm As String
  Dim wb As Workbook
  nm = ThisWorkbook.Name
  Set wb = Workbooks(nm)
  wb.変数 = "bbb"
  MsgBox wb.変数
End Sub
'==================================
Sub test7()
  Dim nm As String
  Dim wb As Object
  nm = ThisWorkbook.Name
  Set wb = Workbooks(nm)
  wb.変数 = "bbb"
  MsgBox wb.変数
End Sub
'==================================
Sub test8()
  Dim nm As String
  Dim wb As ThisWorkbook
  nm = ThisWorkbook.Name
  Set wb = Workbooks(nm)
  wb.変数 = "bbb"
  MsgBox wb.変数
End Sub

今度は、test5〜test8まで全て正常にブックのプロパティを参照できてしまいます。

あれ、test6では、Workbookのメンバに変数はないからエラーになるはずじゃあ
なかったっけ?

どっちの仕様が正しいのかなあ・・・。

これは、コンパイラーのバグなのでしょうか?
対処法があるから、よいけど一貫性がないなあ
・ツリー全体表示

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
2 / 14 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free