Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4865 / 13644 ツリー ←次へ | 前へ→

【53601】置き換えプログラム ma 08/1/24(木) 8:44 質問[未読]
【53602】Re:置き換えプログラム neptune 08/1/24(木) 10:50 発言[未読]
【53603】Re:置き換えプログラム neptune 08/1/24(木) 10:57 発言[未読]
【53604】Re:置き換えプログラム ma 08/1/24(木) 11:25 お礼[未読]
【53606】Re:置き換えプログラム わいわい 08/1/24(木) 12:14 発言[未読]
【53611】Re:置き換えプログラム VBWASURETA 08/1/24(木) 17:35 発言[未読]
【53612】Re:置き換えプログラム わいわい 08/1/24(木) 18:56 発言[未読]
【53615】Re:置き換えプログラム VBWASURETA 08/1/24(木) 20:46 発言[未読]
【53946】Re:置き換えプログラム みそじのおじさん 08/2/17(日) 18:25 回答[未読]

【53601】置き換えプログラム
質問  ma  - 08/1/24(木) 8:44 -

引用なし
パスワード
    ・・・・・
X-155.
X-158.
G00Z100.
M09
M05
G91G00G28Y0.Z0.
G90G54.1X0.
M06
( 16. RADIUSMILL )
N002
G90G00G54X-170.Y7.T5
G43Z100.H3S2000M03
・・・・・

上記の文字列を

・・・・・
X-155.
X-158.
G00Z100.
M09
M05
G91G00G28Y0.Z0.
G90G54.1X0.
G49T3M06
( 16. RADIUSMILL )
N002
G90G00G54X-170.Y7.
G43Z100.H3S2000M03
・・・・・

M06の前に次に来るH××の値をT××
と置き換えるプログラムを作成したいです。

数値はランダムです。


初心者な上、初めての質問で至らない点多々ありますがよろしくお願いします。



【53602】Re:置き換えプログラム
発言  neptune  - 08/1/24(木) 10:50 -

引用なし
パスワード
   ▼ma さん:
こんにちは

>初心者な上、初めての質問で至らない点多々ありますがよろしくお願いします。
とあるので、こんな事書くのはかわいそうなのですが、

・提示されたデータはどこにどのような形であるのか?
 (Excelのシート?、テキストファイル?、それとも他のファイル?)
 ※理由:VBAの掲示板なので、Excelのシートだけの話ではない事があるから。
・置き換えるプログラムを作成したいです。
 作成したいのはわかりますが、何が解らないのか解りません。質問になっていない。

というような理由から有効なアドバイスが受けにくいです。

上記を整理したら、もっと良いアドバイスが受けられるかもしれません。

【53603】Re:置き換えプログラム
発言  neptune  - 08/1/24(木) 10:57 -

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

>M06の前に次に来るH××の値をT××
>と置き換える
これも例ではよく解らん。。。

【53604】Re:置き換えプログラム
お礼  ma  - 08/1/24(木) 11:25 -

引用なし
パスワード
   ありがとうございます。
勉強しなおしてから、また質問させてもらいます。
申し訳ありませんでした。

▼ma さん:
> ・・・・・
>X-155.
>X-158.
>G00Z100.
>M09
>M05
>G91G00G28Y0.Z0.
>G90G54.1X0.
>M06
>( 16. RADIUSMILL )
>N002
>G90G00G54X-170.Y7.T5
>G43Z100.H3S2000M03
>・・・・・
>
>上記の文字列を
>
>・・・・・
>X-155.
>X-158.
>G00Z100.
>M09
>M05
>G91G00G28Y0.Z0.
>G90G54.1X0.
>G49T3M06
>( 16. RADIUSMILL )
>N002
>G90G00G54X-170.Y7.
>G43Z100.H3S2000M03
>・・・・・
>
>M06の前に次に来るH××の値をT××
>と置き換えるプログラムを作成したいです。
>
>数値はランダムです。
>
>
>初心者な上、初めての質問で至らない点多々ありますがよろしくお願いします。
>
>

【53606】Re:置き換えプログラム
発言  わいわい  - 08/1/24(木) 12:14 -

引用なし
パスワード
   もうもう見てないかも知れませんが、せっかく作ってたんで。


挑戦的な質問内容にチョット戸惑い(≧ω≦)b
neptune さんの意見と120%同感ですが、

実は、久しぶりに自分の初質問投稿の内容を見て、ちょ〜赤面しました。
その時の、回答者J○さんに感謝した気持ちは今でも忘れません。
前置きはさておき、
こんなものを作ってみました。

Sub tyousen()
Dim Search_Range   As Range
Dim Hit_Range    As Range
Dim T        As Range
Dim Search_Str     As String
Sheet1.Activate
Search_Str = "M06"
Set Search_Range = Sheet1.Range("A1:A12")
For Each T In Search_Range
  Set Hit_Range = T.Find(What:=Search_Str, LookIn:=xlValues, LookAt:=xlWhole, _
          SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
  If Hit_Range Is Nothing Then
    T.Offset(0, 1).Value = T.Value
  Else
    T.Offset(0, 1).Value = "けろ・けろ" & T.Value
  End If
Next
End Sub


新規ブックのSheet1のA列に

X-155.     
X-158.     
G00Z100.     
M09     
M05     
G91G00G28Y0.Z0.     
G90G54.1X0.     
M06     
( 16. RADIUSMILL )     
N002     
G90G00G54X-170.Y7.T5     
G43Z100.H3S2000M03    
を、入力しておいてから実行してみてねん

ここから質問をやり直しましょう。
でばでば

【53611】Re:置き換えプログラム
発言  VBWASURETA  - 08/1/24(木) 17:35 -

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

こんにちは。

一つ記載させていただきます。


>Search_Str = "M06"

ですが、

Search_Str = "M06*"

にしてみてください^^


実は、下記のコピ&ぺすると空白が後半入るみたいです^^;
それにより、検索判定がFalseになるみたいです。

X-155.     
X-158.     
G00Z100.     
M09     
M05     
G91G00G28Y0.Z0.     
G90G54.1X0.     
M06     
( 16. RADIUSMILL )     
N002     
G90G00G54X-170.Y7.T5     
G43Z100.H3S2000M03

【53612】Re:置き換えプログラム
発言  わいわい  - 08/1/24(木) 18:56 -

引用なし
パスワード
   VBWASURETA さん ありがとうございま〜す (^。^)y-.。o○
ほんとだぁ〜 しかも五つも・・・

同僚の目を気にしながら、文章考えながら、仕事しながら、
ワードパットでやりながらやったからかな〜 (^_^.)

VBWASURETAさん コードを試してくれたんですか〜  ありがとうございます。
まッまさか、ためさづともお気付きになった? (@_@;)
石の方拝見しました。今後ともよろしくお願いします。

【53615】Re:置き換えプログラム
発言  VBWASURETA  - 08/1/24(木) 20:46 -

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

こんばんは。

実は最近同じようなの作っていたので。
こんな感じのです。で、わいわいさんのソースのほうが
シンプルでいいなっと見ていたらきづいただけですけどね^^;


あ、こちらこそ、宜しくお願いします。


Sub main()
  Dim SearChIndex As Integer
  Dim firstAddress As Integer
  Dim SearchRange As Range
  
  'B列の検索
  With ActiveSheet.Range("B:B")
    '検索
    Set SearchRange = .Find("*" & "M6" & "*", LookIn:=xlValues)
    
    '検索の文字が見つかった
    If Not SearchRange Is Nothing Then
      '最初に見つかったセル位置確保(同じ検索繰り返し防止)
      firstAddress = SearchRange.Address
      Do
        '見つかった行位置確保(これはセルに書き込むための確保)
        SearChIndex = SearchRange.Row
        '見つかったので見つかったセル行の2列目に書き込むかっと。
        ActiveSheet.Cells(SearChIndex, 2) = "変更"
        '次の検索へ
        Set SearchRange = .FindNext(SearchRange)
        'まだ次の行がある
        If Not SearchRange Is Nothing Then
          '次の行はもしかして最初の検索だったりする?
          If (SearchRange.Address = firstAddress) Then
            'んじゃ終る
            Exit Do
          End If
        End If
      Loop While Not SearchRange Is Nothing
    End If
  End With
End Sub

【53946】Re:置き換えプログラム
回答  みそじのおじさん  - 08/2/17(日) 18:25 -

引用なし
パスワード
   こんばんは。maさんもう見ていないかな?

私はmaさんと同じ機械加工業をしている物です。(いつもは質問者です。)

maさんが提示されたデータはJISで規定されている、工作機械を動かす為の

Gコードと呼ばれるNCプログラムです。(みなさんがいま触っているマウスも

こういうデータによって、金属を機械で削り出してオス、メスの金型がつくら

れ出来ています。)私もNCプログラムをあれこれいじるプログラムをVBAでよ

く作るので、興味があって作ってみました。

maさんのやりたかった事が 次工具を呼ぶのをやめて、工具交換⇒工具長⇒

加工⇒工具交換⇒工具長⇒加工⇒終了 だったとすると(私が見た限りでは

こう解釈しましたが....違いました?)


標準モジュールにこれをコピーして下さい。実行するとファイル選択の

ダイアログがでてくるので、変換するプログラムを選択して下さい。

(選択したファイルを書き換えてしまう為、念のためファイルコピー

をしておいた方がいいです)


Sub NC_PRO_CHANGE()

Dim FlName As String
Dim i As Integer
Dim myTxt As String
Dim MyPRO() As String
Dim LineCount As Long
Dim M06Fg As Integer, HitFg As Integer
Dim myHNo As Integer, myTNo As Integer
Dim M06Count As Integer
Dim l As Long
Dim p As Integer, findH As Integer, pp As Integer

Dim hanteiMOJI(1 To 13) As String

hanteiMOJI(1) = "0"
hanteiMOJI(2) = "1"
hanteiMOJI(3) = "2"
hanteiMOJI(4) = "3"
hanteiMOJI(5) = "4"
hanteiMOJI(6) = "5"
hanteiMOJI(7) = "6"
hanteiMOJI(8) = "7"
hanteiMOJI(9) = "8"
hanteiMOJI(10) = "9"
hanteiMOJI(11) = "-"
hanteiMOJI(12) = "."
hanteiMOJI(13) = " "

On Error GoTo ERR_TRAP:

i = FreeFile

FlName = Application.GetOpenFilename()

If FlName = "False" Then Exit Sub

 M06Count = 0
 LineCount = 0
 M06Fg = 0
 myHNo = 0
 myTNo = 0

Open FlName For Input As #i
 Do Until EOF(i)
   Line Input #i, myTxt
    LineCount = LineCount + 1
     ReDim Preserve MyPRO(1 To 1, 1 To LineCount) As String
     
      MyPRO(1, LineCount) = myTxt
 Loop
Close #i

For l = 1 To UBound(MyPRO, 2)
 If Left(MyPRO(1, l), 3) = "M06" Then
   M06Fg = 1: m06row = l: M06Count = M06Count + 1
 End If
 
 
 If Left(MyPRO(1, l), 1) = "O" Or Left(MyPRO(1, l), 1) = "$" Or Left(MyPRO(1, l), 1) = "(" Then
 Else
  
    If InStr(1, MyPRO(1, l), "H") > 0 And M06Fg = 1 Then
     findH = InStr(1, MyPRO(1, l), "H")


      For pp = findH + 1 To Len(MyPRO(1, l))
      For p = 1 To 13
      HitFg = 0
       If Mid(MyPRO(1, l), pp, 1) = hanteiMOJI(p) Or pp = Len(MyPRO(1, l)) Then
        HitFg = 1
        If pp = Len(MyPRO(1, l)) Then pp = pp + 1: HitFg = 0
        
        Exit For
       End If
      Next
      
      If HitFg = 0 Then
        myHNo = Mid(MyPRO(1, l), findH + 1, pp - (findH + 1))
        Exit For
      End If
      
      
     Next
    End If
    
   If InStr(1, MyPRO(1, l), "T") > 0 And M06Count >= 1 Then
     findH = InStr(1, MyPRO(1, l), "T")
     
      HitFg = 0
     
      For pp = findH + 1 To Len(MyPRO(1, l))
      
      For p = 1 To 13
        HitFg = 0
       If Mid(MyPRO(1, l), pp, 1) = hanteiMOJI(p) Or pp = Len(MyPRO(1, l)) Then
        HitFg = 1
        If pp = Len(MyPRO(1, l)) Then pp = pp + 1: HitFg = 0
        Exit For
       End If
      Next
      
      If HitFg = 0 Then
        myTNo = Mid(MyPRO(1, l), findH + 1, pp - (findH + 1))
       
        myTrow = l
        MyPRO(1, l) = WorksheetFunction.Replace(MyPRO(1, l), findH, Len(myTNo) + 1, "")
        Exit For
      End If
      
      
     Next
   End If
    
    If M06Count = 1 Then
      M06Fg = 0: myHNo = 0: myTNo = 0
     
    Else
      If M06Fg = 1 And myHNo <> 0 Then
        MyPRO(1, m06row) = "G49M06T" & myHNo
        M06Fg = 0: myHNo = 0
      End If
    End If
    
 End If
 
Next

Open FlName For Output As #i

  For pp = 1 To UBound(MyPRO, 2)
   Print #i, MyPRO(1, pp)
  Next
  
Close #i

MsgBox "変換が終了しました。"
Exit SUb

ERR_TRAP:

End Sub


maさんはプログラムの先頭を省略していましたが、私の推測で最初の

工具交換指令までなくなっては困ると思い一回目のT**はそのまま残る

用にしてあります。なのでここに提示されているデータでは変換はされ

ません。(対応しているのは工具交換指令が2回以上あるデータに対して

有効です。)    これも推測ですが、機械の対話もしくはCAD-CAM

でプログラムを作成されているなら関係ありませんが、手打ちで作っ

ている場合、M06をM6とした場合は変換されませんのでご注意を。

4865 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free