- 締切済み
エクセル セルの先頭の0 VBAで
テキストファイル.txtにおける数値 たとえば01234567の８桁を エクセルファイルの（A,1）セルに移動すると 1234567と表示されてしまいます あるコードがあるとしまして 途中省略しますが ・・・・・ .Cells(A, 1).Value = Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) これは あるプログラムの流れということですが これで 1234567 となってしまうので このコードのあとに Range (Cells(A, 1)) .NumberFormatLocal = "@" .Value = Format(.Value, "00000000") （この場合は ８桁とすでにわかっている場合ですが もし先頭に0がいくつ付くかわからない場合のケースも 教えていただけますか） とつけましたが エラーとなります 御教示くださいませ win10 office356
- sushidokei
- お礼率64% (252/389)
- Visual Basic
- 回答数6
- ありがとう数8
- みんなの回答 （6）
- 専門家の回答
みんなの回答
- chie65535
- ベストアンサー率43% (8522/19371)
以下のコードは、A1に「1234567」を代入し、その後、A2セルに入っている数値を「桁数」として、桁揃えするコードです。 Sub ボタン1_Click() n = Cells(2, 1) With Cells(1, 1) .Value = 1234567 .NumberFormatLocal = "@" .Value = Format(.Value, String(n, "0")) End With End Sub ＞とつけましたが ＞エラーとなります 質問にある Range(Cells(A, 1)) という記述は「VBAでは意味不明」で、エラーになります。 どこかのサイトの例題を見て .NumberFormatLocal = "@" .Value = Format(.Value, "00000000") と書いたのでしょうけど、この例題の前後には With Range("A1") .NumberFormatLocal = "@" .Value = Format(.Value, "0000") End With のように「With 〇〇」～「End With」があった筈です。 VBAでは「繰り返し、同じプロパティを書く場合に、プロパティを省略できる機能」があります。 例えば Cells(1, 1).Value = 1234567 Cells(1, 1).NumberFormatLocal = "@" Cells(1, 1).Value = Format(.Value, String(n, "0")) と、何度も「Cells(1, 1)」と書く必要が出た場合に With Cells(1, 1) .Value = 1234567 .NumberFormatLocal = "@" .Value = Format(.Value, String(n, "0")) End With のように「Cells(1, 1).」を「.」一文字に省略できます。 因みに、 .Value = Format(.Value, String(n, "0")) を .Value = Right(String(n, "0") & .Value, n) に書き換えると「溢れた桁を切り捨て」できるようになります。 例えば「123456789」を「8桁にする」と、先頭が切り捨てされ「23456789」のように「必ず８桁」に出来ます。 Formatを使った場合は、「123456789」を「8桁にする」と指定しても、9桁の「123456789」になり「８桁にならない」場合があります。
- kkkkkm
- ベストアンサー率65% (1618/2457)
No.1で bufなら mStr = buf と回答しましたが、bufは既になにがしかの文字列で以下で使ってましたね。 > .Cells(A, 1).Value = Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) > これで 1234567 となってしまうので これは、Str(Mid())の結果が1234567だけど0を付加して8桁として表示したいのだと思ってましたが (もとになる0が付いている文字列が別途取得できると思ってました) Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) の結果は01234567だけど A1が1234567になるという事でしたら もとの文字列は Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) だと思いますから mStr = Str(Mid(buf, Pos9 + Len9, Pos10 - (Pos9 + Len9))) になります。
- FattyBear
- ベストアンサー率32% (1219/3724)
単純に移動先のセルの書式設定の表示形式が”数値”ならば頭の０は 無くなります。そのデーターを数値と判断されたのでしょう。 01234567 は数字の羅列に過ぎません。数値ではないのです。 00001234 も同じ、数字を一つずつ並べたもので数値ではない。 移動先の書式設定の表示形式が”文字列”なら01234567 とそのまま 表示されます。 VBAでセルの書式設定をするコマンドがあればそれを組み込めば良い。 私はVBAにうといのでそれは知りませんが。
- kkkkkm
- ベストアンサー率65% (1618/2457)
> 先頭に0がいくつ付くかわからない場合 コードを実行するまで文字列の長さがわからないという意味だと思ってますので 文字列の長さ以外の要因で桁数が変化するのでしたら たとえば長さが9になるとしたら mStr = "1234567" n = 9 With Cells(1, "A") .NumberFormatLocal = "@" .Value = Format(mStr, String(n, "0")) End With
- kkkkkm
- ベストアンサー率65% (1618/2457)
No.1は質問のコードを変更しましたが 書式設定を文字列にしていますから桁を気にせず文字列変数の値を直接代入すればいけると思います。 mStr = "001234567" With Cells(1, "A") .NumberFormatLocal = "@" .Value = mStr End With
- kkkkkm
- ベストアンサー率65% (1618/2457)
元の文字列が何か分からないので"001234567"のところに元の文字列を配置してください。 bufなら mStr = buf mStr = "001234567" n = String(Len(mStr), "0") Range("A1").Value = mStr With Cells(1, "A") .NumberFormatLocal = "@" .Value = Format(.Value, n) End With
お礼
複数回に亘っての御回答頂戴し恐縮です 有り難う御座いました。
関連するQ&A
- エクセルファイル 行列入れ替えたもの同時作成VBA
あるxmlファイルを一旦テキストファイルにして そこから数値をエクセルファイルに移行して ひとつはM.xlsxとし それに続いて行列を入れ替えた エクセルファイルR.xlsxを 作りたいのですが M.xlsx R.xlsxのそれぞれを作るコードを 単純に 合体させただけでは どうも できません M.xlsxだけ また R.xlsxだけの 作成するコードは 出来たのですが それぞれ別のマクロとして実行することになります ひとつのマクロでM.xlsx R.xlsx同時に 作成するVBAコードは可能でしょうか 宜しくお願い致します ちなみに該当コードを単純化して 合体したのが以下のものです win10 office10 Sub 783縦() Dim FileName As Variant ChDir "\\DESKTOP-O5\f" FileName = Application.GetOpenFilename(FileFilter:="xmlファイル,*.xml") If FileName = False Then MsgBox "キャンセルされました" Exit Sub End If FileCopy FileName, Left(FileName, InStrRev(FileName, "\")) & "テキスト.txt" Const MyFile = "\\DESKTOP-O5\f\テキスト.txt" Const Key1 = "<Name>" Const Key2 = "</Name>" Const Key3 = "<NameKana>" Const Key4 = "</NameKana>" Const PutBokName = "M.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(1, 2).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(2, 1).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With Const PutBokName = "R.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(2, 1).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(1, 2).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With End Sub -------------------------------
- 締切済み
- その他（プログラミング・開発）
- Excel VBA セル選択
Sub 全角() Dim i As Long, buf As String For i = 1 To Len(ActiveCell.Value) If Mid(ActiveCell.Value, i, 1) Like "[ア-ン]" Then buf = buf & StrConv(Mid(ActiveCell.Value, i, 1), vbWide) Else buf = buf & Mid(ActiveCell.Value, i, 1) End If Next i ActiveCell.Value = buf End Sub このコードだと一つのセルしか変換できません。 選択した範囲全部を変換できるようにしたいです。
- ベストアンサー
- Excel（エクセル）
- 【VBA】セルの中身を日付形式に変換したい
w列のセルの中に20140701のように入っているセルを2014/07/01に変換するマクロを作っております。 それで以下のように書いてみたのですが、「型が一致しません」と出てしまい、先に進めずにおります…。お力借りられますと幸いです。 Dim org As String Dim buf As String Dim i As Long i = 1 Do Until Cells("w", i) = "" Cells("w", i).Select With ActiveCell org = .Value If Len(org) = 8 Then buf = _ Mid(org, 1, 4) & "/" & _ Mid(org, 5, 2) & "/" & _ Mid(org, 7, 2) If IsDate(buf) = True Then .Value = buf .NumberFormatLocal = "yyyy年m月d日" End If End If End With i = i + 1 Loop
- 締切済み
- Excel（エクセル）
- VBA エクセル 文字列の桁数指定 先頭に"0"
お世話になります。 セルに入力されたコードが、指定された桁数未満であった場合に、足りない桁数分を調整するため先頭に"0"ゼロを追加したいと思っております。 具体的には、10桁に指定されたコード番号を、間違えて6桁で入力した場合、先頭に"0000"を追加して10桁に調整したいのです。 (1)誤：54321Q ↓調整 (2)正：000054321Q 入力したら瞬時に修正をさせたいので、WorksheetにChengeEventを利用して書こうと思っているのですが、下記のとおり入力された桁数が1~9桁であった場合のそれぞれの指定を書くことしか思いつかなくて。 もう少し、Simpleな書き方はないものでしょうか？ ～前略～ s = Cells(Target.Row, Target.Column).Value If s = "" Then Exit Sub End If i = Len(s) If i > 10 Then MsgBox "顧客番号(ICRIS#)は10桁です。" Exit Sub ElseIf i = 1 Then Cells(Target.Row, Target.Column).Value = "000000000" & s exitsub ElseIf i = 2 Then Cells(Target.Row, Target.Column).Value = "00000000" & s exitsub ～省略～ よろしくご指導くださいませ。
- ベストアンサー
- その他MS Office製品
- セルの値を取得して他のセルにひとつづつ配置したい
こんにちわ VBS初心者です A1セルに12～14ケタほどの英文字と数字が混在したコードがあります それをB2,C2,D2,E2・・・・・セルに左から順にひとつづつ配置したいのですが、どうも上手く行きません Sub test4() Value = Range("A1") Range("A2").Value = Mid("A1", 1, 1) Range("B2").Value = Mid("A1", 2, 1) Range("C2").Value = Mid("A1", 3, 1) Range("D2").Value = Mid("A1", 4, 1) Range("E2").Value = Mid("A1", 5, 1) Range("F2").Value = Mid("A1", 6, 1) Range("G2").Value = Mid("A1", 7, 1) Range("H2").Value = Mid("A1", 8, 1) Range("I2").Value = Mid("A1", 9, 1) Range("J2").Value = Mid("A1", 10, 1) Range("K2").Value = Mid("A1", 11, 1) Range("L2").Value = Mid("A1", 12, 1) Range("M2").Value = Mid("A1", 13, 1) Range("N2").Value = Mid("A1", 14, 1) End Sub "A1"を値としてとらえているようで B2にはAが、C2には1が入ってしまいます A1の値を取り出すにはどうしたら良いでしょうか よろしくお願いします
- 締切済み
- Windows系OS
- excelのファイルとセル値を書き出したい
excel2003を利用しています。 とあるフォルダにある excelファイル名(自分自身のファイルを除く） を全て書き出して、 且つ A１セルの値をB列に書き出すことを、やろうとvbaを作ってみましたが。 最後のファイルのA1セルを書きだすところで、エラーになっていまい そこだけ空白になってしまいます。※写真参照 記述は以下の通りです。どのように修正すればよいか 教えていただけないでしょうか？ また他にもっと優れた記述があれば、そちらも教えて欲しいです。 よろしくお願いします。 Sub test() Dim buf As String, cnt As Long Dim Path As String Path = ThisWorkbook.Path & "\" buf = Dir(Path & "*.xls") cnt = 2 Do While buf <> "" If buf <> ThisWorkbook.Name Then cnt = cnt + 1 Cells(cnt, 1) = buf buf = Dir() Workbooks.Open Filename:=Path & "\" & buf MsgBox Workbooks(buf).Worksheets(1).Range("A1").Value Cells(cnt, 2) = Workbooks(buf).Worksheets(1).Range("A1").Value Workbooks(buf).Close End If Loop End Sub
- 締切済み
- Excel（エクセル）
- エクセル 00120034 左の00だけ消したい
エクセルのデータ セル A1において 00123456 という数値があったとした場合 エクセルでは先頭左に00が消えてしまうので それが残るようにするために ここでアドバイスを頂き With Range("A1") .NumberFormatLocal = "@" .Value = Format(.Value, "00000000") End With If Left(Range("A1"), 2) = "00" Then Range("A1").Value = Replace(Range("A1").Value, "00", " ") End If 上記で A1には __123456 とでるようにはなったのですが A1が 00120034 という8桁の 真ん中に00が 入る数値ですと __12__34 となってしまいます おそらくReplace(Range("A1").Value, "00", " ") ここの00すべてを読み込むからだとは思います お伺いしたいのは 00120034 みたいな 間に00があるときに 左の00だけ 空白にして 間の00は残すには どうしたら よろしいでしょうか __120034 と でるようにしたいわけです 宜しくお願い致します office365 win10
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAについて
こんにちは、VBA初心者です。 C:\pictureの中に以下のファイルがあります。 DSC_0134.JPG～DSC_0154.JPG これらのファイルをExcelのA列1～20行に書かれた文字△○％＆◎～▲▽％％★に.JPGをつけて保存したくて以下のコードを書きました。 Dim buf As String Dim msg As String Dim i As Integer Dim A As Variant i = 1 buf = Dir("dsc*.jpg", vbNormal) Do While buf <> "" Do While i < 21 buf = Dir() msg = buf 'msg=元の名前 A = Worksheets("sheet1").Cells(i, 1).Value Worksheets("sheet1").Cells(i, 2).Value = msg Name "C:\picture\msg" As "C:\picture\A.jpg" i = i + 1 Loop Loop Name "C:\picture\msg" As "C:\picture\A.jpg"のところで、「ファイルがありません。」となってしまいます。 あと、Worksheets("sheet1").Cells(i, 2).Value = msgのところで、\pictureの中の最初のファイル（DSC_0134.JPG）を表示しません。 どこを直せばよいのでしょうか？
- ベストアンサー
- Visual Basic
- Excelでwatabeさんに複数のセルを参照
Excel2007でwatabe007さんに以前に作って頂いたこのようなソースがあります。 Sub Test4() Dim LastO As Long, LastG As Long Dim i As Long, str As String Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents LastO = Cells(Rows.Count, "O").End(xlUp).Row Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value str = Range("A3").Value & Range("B3").Value & Range("C3").Value For i = 3 To LastO If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1 If LastG < 3 Then LastG = 3 Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value End If Next End Sub これにいつも格子をつけて文字がセンターになるようにしたいですがどうすればよろしいですか？解答よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- エクセルVBAを修正したい
数字を入力すると記号に変換になるマクロを 元ファイルを修正して作成したいのですが、 以下の記述が理解できません。 具体的にどのような処理をしているのか教えて下さい。 Do While Len(Range("C" & CStr(I)) & Range("D" & CStr(I))) > 0 For J = StartCol To EndCol If Len(ActiveSheet.Cells(12, J).Value & ActiveSheet.Cells(13, J).Value) > 0 Then tmp = "" If ActiveSheet.Cells(I, J).Value = "×" Or ActiveSheet.Cells(I, J).Value = "中止" Then ' ActiveSheet.Cells(I, J).Value = "中止" 'ActiveSheet.Cells(I, J + 1).Value = "" Else If Len(ActiveSheet.Cells(I, J).Value) = 0 Then K = -1 Else K = ActiveSheet.Cells(I, J).Value End If Select Case K Case 0 tmp = "×" Case 1 To 9 tmp = "△" Case Is >= 10 tmp = "○" Case Is < 0 tmp = "**" End Select
- 締切済み
- Visual Basic
お礼