• 締切済み

VBA 4桁の文字列にするには

お世話になっております。 相変わらず初心者です。また質問させてください。 基本的なことが原因でしたら大変申し訳ありません。 E列(添付の「番号」列)を4桁の文字列にしたくて、 下記のように組んでみたのですが、 家のPCで実行すると問題なくE列が4桁の文字列:333だったら0333 になるのですが、 友人のPCで実行すると4桁の文字列:333のとき、実行後も333のままです。 何が原因なのかまったくわからず、途方にくれています。 どうすれば無事に動くのかどなたか教えてください。 With ActiveSheet.Range("A1").CurrentRegion Dim i As Long For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row .Range("J:J").NumberFormatLocal = "@" .Cells(i, 10) = Format(.Cells(i, 5), "0000") .Cells(i, 5) = .Cells(i, 10) Next i End With

みんなの回答

  • HohoPapa
  • ベストアンサー率65% (448/684)
回答No.3

いまだ未解決なら 掲示された画像に列番号、行番号がありません。 これらを含めた画像にし マクロ実行前後(つまり双方)の画像をポストし 再質問してみてください。 また、 Dim i As Long MsgBox (.Cells(Rows.Count, 1).End(xlUp).Row) For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row といったコードに書き換えて実行し 期待通りの行番号かを確認してみてください。

回答No.2

.Range("E:E").NumberFormatLocal = "@" でダメだったということですが、書式設定は文字列になっていたでしょうか? 文字列として入れたらどうでしょうか? .Cells(i, 5) = CStr(.Cells(i, 10)) CstrはConvert to stringsの意味だと思います。

回答No.1

.Range("E:E").NumberFormatLocal = "@" を追加すればよいと思います。 そもそも .Cells(i, 5) = .Cells(i, 10)は .Cells(i, 5).value = .Cells(i, 10).value なので、書式までコピーされるのはエクセルの配慮があるときだけだと思います。(要は気まぐれ)

MINYA3481
質問者

お礼

お忙しい中ご回答いただき、ありがとうございました!

MINYA3481
質問者

補足

ご回答ありがとうございました。 早速試してみたのですが、やはり変わらず・・・でした。 毎回、別の部署から送られてきたものを担当の友人のPCで作業を行うので、 どうしたらよいものか悩んでいます。 何かほかに良いお知恵がありましたらぜひ教えてください!

関連するQ&A

  • Excel VBAで文字列の部分一致の文字列を表示

    以前、こちらで頭5文字までの一致で文字列を表示するVBAを教えて頂きました。今回はFINDなどの部分一致での文字列を表示することをしたいのですが、ご教示いただけますと幸いです。 下記はSheet1のA3に文字を5文字以内いれるとSheet2のC列からピックアップしてSheet1のA列に文字列を表示する及びSheet2のB列のデータをSheet1のC列に表示させるVBAです。 Sub Test2() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim SData As String, i As Long, VRet As Variant Dim c As Range, LastRow As Long Set Ws1 = Sheets("Sheet1") Set Ws2 = Sheets("Sheet2") SData = CStr(Ws1.Range("A3").Value) If SData = "" Then Exit Sub i = 5 LastRow = Ws1.Cells(Rows.Count, "A").End(xlUp).Row If LastRow < i Then LastRow = i End If Ws1.Range(Ws1.Cells(i, "A"), Ws1.Cells(LastRow, "C")).ClearContents With Ws2 For Each c In .Range(.Cells(1, "C"), .Cells(Rows.Count, "C").End(xlUp)) VRet = InStr(1, CStr(c.Value), SData, vbTextCompare) If VRet = 1 And Len(c.Value) >= 10 Then Ws1.Cells(i, "A").Resize(1, 2).Value = c.Resize(1, 2).Value 'とりあえずSheet2のB列のデータ(C列のデータに同期したデータ)をSheet1のC列に Ws1.Cells(i, "C").Value = .Cells(c.Row, "B").Value i = i + 1 End If Next End With End Sub 宜しくお願い致します。

  • Excel VBAについて教えて下さい。

    00というブックとテストというブックがあります。 00のデータを並び替え、一部変更し、テストのシート3へ貼付けを行いたいのですが、 うまく作動してくれません。以下に現在のコードを記載しましたので、ご指摘いただければと思います。 やりたいことは 1.ブック”00”のシート00にて条件がF列が0、E列がHでソートをかけます。 2.E列のHをすべて数字の1に変更します。 3.今度は別の条件、F列が1、E列がH、D列が1でソートをかけます。 4.E列のHをすべて消去します。 5.すべて表示させA列からE列までのデータを、テストのシート3へ貼付けをします。 コピー&ペーストは上手くいくのですが、肝心のソート+文字の変更+消去が出来ていません。 ネットを見ながら書いたコードで、VBAを勉強中です。 よろしくお願いします。 あと、この作業の前にブック00のB列にて昇順のソートをかけるというコードを追加したいのですが、 それについても教えていただけるとうれしいです。 よろしくお願い致します。 Private Sub Worksheet_Activate() Dim wb1 As Workbook Dim wb2 As Workbook Dim i As Long Application.ScreenUpdating = False Set wb1 = ActiveWorkbook Set wb2 = Workbooks.Open("C:\Documents and Settings\デスクトップ\メモ\00.xls", ReadOnly:=True) With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", "1") End If Next i With wb2.Worksheets("00").Range("A1").CurrentRegion .AutoFilter .AutoFilter Field:=6, Criteria1:="=" & "0", Operator:=xlAnd .AutoFilter Field:=5, Criteria1:="=" & "H", Operator:=xlAnd .AutoFilter Field:=4, Criteria1:="=" & "1", Operator:=xlAnd .AutoFilter x = .Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To x If Cells(i, 5) = "H" Then Cells(i, 5) = Replace(Cells(i, 5), "H", " ") End If Next i wb2.Sheets("00").Range("B1", .Cells(Rows.Count, 5).End(xlUp)).Copy wb1.Sheets("Sheet3").Range("K3").PasteSpecial wb2.Close False Range("A1").Select Application.ScreenUpdating = True End With End With End Sub

  • 文字変換マクロについて

    数値を文字列に変換するマクロで、行数や列数が増えても対応できるようにしたいです。 (並びは…数値 スペース 文字列)どなたか教えてください。 よろしくお願いします。 Sub 文字() Dim i As Long For i = 1 To Range("A1").End(xlDown).Row Cells(i, "C") = Cells(i, "A") With Cells(i, "C") .NumberFormatLocal = "@" .Value = StrConv(Cells(i, "C").Value, vbNarrow) .Value = Format(Cells(i, "C").Value, "'00") End With Next i End Sub

  • エクセルVBA  どうしても動きません。

    お世話になります。 なかなか上達しない超初心者です。 ↓↓ですが、Activesheetにすると動くのに、シート名を元々存在するシート”実験"に指定すると動きません(データ内容はまったく同じで、A列に色んな名前が入っていて、重複しているとC列に重複と入力します)。 2日間試行錯誤したのですが、やっぱり動かず・・・ ちなみに、Activateにするとアクティブになるし、CurrentRegionも選択できるのに なんでうごかないんでしょうか・・・ 何卒ご指導くださいませ。よろしくお願いいたします!!!!!! Sub Test2() With Sheets("実験").Range("A1").CurrentRegion Dim i As Long Dim LastRow As Long LastRow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To LastRow If WorksheetFunction.CountIf(Range("A:A"), Cells(i, 1)) > 1 Then Cells(i, 3) = "重複" End If Next i End With End Sub Sheets("実験")をActivesheetに変えると別のシートがしっかり動いてくれます・・・が、なんとしてでも”実験”シートに動いていただきたいです・・・。

  • ある文字を含む列と同じ行にある列と一致の文字の除外

    "名称"(D列)で*ABCD*と含まれるものと同じ行にある"番号"(B列)が一致するものを全て除外したい(D列の値は異なるが、 B列の値が一緒なものを除外したい)。 下記のコードに上記の内容のコードを加えたいのですがやり方を教えていただけないでしょうか? ちなみにVBA初心者なためお手柔らかにお願い致します。 Sub 分別() Dim j As Long j = Cells(Rows.Count, 1).End(xlUp).Row With Range(Cells(3, 1), Cells(j, 43)) .AutoFilter Field:=37, Criteria1:="EFGK" .AutoFilter Field:=4, Criteria1:="*FF0001*", Operator:=xlOr, Criteria2:="*DD0002*" End With End Sub

  • VBAで列が可変のオートフィルの実装

    元となるSheet1のR列を「Sheet1~3」以外のシートの名前で オートフィルターさせてその内容をコピーし、数式を代入させたあと、連続データをEの列の最終セルまで 連続させてコピーするという下記のVBAを実装しました・・・が 連続データさせるEの列が1つしかなかった場合、連続データできないのでエラーが起きてしまします ですのでそれは無視してよいと単純に「On Error Resume Next」で処理しちゃってます でもこれでは、あまり良くない処理のような気がするのですが・・・ 連続データ出来ない場合は、1つのセルに数式を代入するだけでおしまい というプログラム処理はどのようにやればいいのでしょうか? ' オートフィルター For Each sh In Worksheets If sh.Name <> "Sheet1" And sh.Name <> "Sheet2" And sh.Name <> "Sheet3" Then Dim Filtarget As Range Dim Maction As Range 'コピーの開始する場所 Set Filtarget = Sheets(sh.Name).Range("A4") Set Maction = Sheets(sh.Name).Range("W4") Set Fills = Sheets(sh.Name).Range("X4") With Sheets("Sheet1").Range("R3") .AutoFilter Field:=18, Criteria1:=sh.Name .CurrentRegion.Copy With Worksheets.Add .Paste .Range("1:3").Delete .UsedRange.Copy Filtarget .Range("X1").Formula = "=E1/W1" .Range("M1:M" & Cells(Rows.Count, 13).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Maction .Range("X1").AutoFill Destination:=Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible) On Error Resume Next .Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible).NumberFormatLocal = "\#,##0;\-#,##0" .Range("X1:X" & Cells(Rows.Count, 5).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Fills Application.DisplayAlerts = False .Delete Application.DisplayAlerts = True End With .AutoFilter Field:=18 End With End If Next 以上、よろしくお願い致します。

  • <excel:VBA>変数を使って簡略化したい

    google検索してなんとか自力で作ったVBAを下記に貼りました。 きちんと動作はするのですが、せっかくなので変数を使って簡素化し、 データが多くても動作が速くなるようにしたいのです。 いろいろ試しましたが、変数の使い方の知識が乏しく、うまくいきませんでした。 変数としたいのは■マークの2箇所になると思います。 詳しい方、力を貸していただけないでしょうか。 どうぞよろしくお願いいたします。 ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■ Sub オートフィルタ貼付作業() With Sheets("データ").Range("A3") Application.ScreenUpdating = False Range("AA3:EK3").AutoFilter .AutoFilter Field:=1, Criteria1:="1" ’■Fieldが1ずつ増えていく Range("AA3").Copy Range("Z3") ’■AA3が1列ずつ右へずれていく .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter Range("AA3:EK3").AutoFilter .AutoFilter Field:=2, Criteria1:="1" Range("AB3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter ~~~~~~~~~~~~ 115列分のデータがあり 下記まで同じようにつづきます ~~~~~~~~~~~~ Range("AA3:EK3").AutoFilter .AutoFilter Field:=115, Criteria1:="1" Range("ek3").Copy Range("Z3") .CurrentRegion.Copy Sheets("貼付").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Range("A3").AutoFilter End With Application.ScreenUpdating = True Sheets("貼付").Activate Cells.Columns.AutoFit End Sub ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■

  • (VBA)文字列を指定位置から抜き出す

    Office2019,Windows10 文字列の指定位置から文字列の最後までを抜き出すコード(文字列())を作成しました。 現在は、指定文字列位置を指定するのに目で数えて指定しますが  数え間違えが多いのでミスを少なくする方法を検討しました。 以前教えてもらったコード(Nubering3())が利用したいのですが、 イメージだけでどうしたらいいか分かりません。 イメージとしては、  1)range(A1)の文字列で添付画像のような画像を表示して、   画像の下部に「どこから? 数値を入力してください」と表示して   抜き出し開始位置の数値を入力する   添付画像のように文字数が多くなると行が長くなるので    40文字毎に改行されて表示させる    (改行が難しい場合は、それに代わる方法でもOKです。)  2)数値が入力されれば、最初の画像(のような)は消えて     B列に抜き出し結果が表示される。 ---------------------------------------------------------------- Sub Mid文字列() Dim MojiSuu As Single Dim KokoKara As Variant Dim I As Single Dim Nukidashi As String Dim EndRow As Single EndRow = Cells(1, "A").End(xlDown).Row KokoKara = Application.InputBox(prompt:="どこから? 数値を入力してください", Title:="数値入力", Type:=1) If TypeName(KokoKara) = "Boolean" Then MsgBox "数値以外が入力されたので終了します。" Exit Sub End If For I = 1 To EndRow MojiSuu = Len(Range("A" & I)) Nukidashi = Mid(Range("A" & I), KokoKara, MojiSuu) Range("B" & I) = L Next I End Sub --------------------------------------------------------------- Sub Nubering3() Dim Ws1 As Worksheet, Ws2 As Worksheet Dim i As Long, j As Long, WRow As Long Dim uRows As Range, uRange As Range Set Ws1 = Sheets("DATA") Set Ws2 = Sheets("Number") Set uRows = Ws2.Rows(1) Set uRange = Ws2.Range("A2") 'Numberシートの初期化(全体=数式・文字・書式・コメント全てをクリア) Ws2.Range("A1:XX100").Clear Application.ScreenUpdating = False For i = 2 To Ws1.Cells(Rows.Count, "A").End(xlUp).Row WRow = Ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 If Ws2.Range("A1").Value = "" And WRow = 2 Then WRow = 1 End If Set uRows = Union(uRows, Ws2.Rows(WRow)) For j = 1 To Len(Ws1.Cells(i, "A").Value) Ws2.Cells(WRow, j).Value = j Ws2.Cells(WRow + 1, j).Value = Mid(Ws1.Cells(i, "A").Value, j, 1) Set uRange = Union(uRange, Ws2.Cells(WRow + 1, j)) Next Next i 'Numeling 大文字、中央揃え uRows.HorizontalAlignment = xlCenter uRows.Font.Bold = True '分割文字中央揃え罫線外枠 uRange.HorizontalAlignment = xlCenter uRange.Borders.LineStyle = xlContinuous 'セル幅を見やすく Ws2.Range("A1:xx100").ColumnWidth = 3 Application.ScreenUpdating = True Ws2.Activate Set Ws1 = Nothing Set Ws2 = Nothing Set uRows = Nothing Set uRange = Nothing End Sub

  • VBAでの質問

    お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.(5,2)がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3)  ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub

  • VBA 別シートからコピー貼付け(複数列)

    別シートからコピー貼付け(複数列)をしたいのですが,同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし,別シートsheet1からsheet2ヘコピーで修正しましたが,「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

専門家に質問してみよう