[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力した文字を一文字ずつ表示したい』(Excel初心者)
A44に入力というボタンを作っていましてその横のB44に入力した文字をしたのをA45から横に一文字ずつ表示したいのですがどうすればよいでしょうか。
現在はこのような感じです。
Sub ボタン1()
k = 45
Dim c As String
c = Range("B44").Formula
Debug.Print (c)
Dim h As String
h = Range("L44").Formula
Debug.Print (h)
j = 1
Dim arr() As String
Dim i As Long
Dim leng As Long
leng = Len(c)
ReDim arr(leng - 1)
For i = 0 To leng - 1
arr(i) = Mid(c, i + 1, 1) Next i
For i = 0 To leng - 1
ここからわかりません
Next i
End Sub
< 使用 Excel:unknown、使用 OS:unknown >
Range("A45").Offset(,i).Value = arr(i)
「ここからわかりません」のところ、たとえばこんな感じで
(作業員) 2022/06/28(火) 14:15
Sub Sample() Dim buf As String, i As Long buf = Cells(44, "B").Formula Do While i < Len(buf) i = i + 1 Cells(45, i).Value = Mid(buf, i, 1) Loop End Sub
Doループを使う例
(作業員) 2022/06/28(火) 14:23
具体例を教えてください
(作業員) 2022/06/28(火) 14:44
Dim h As Long, h2 As Long h = Range("L44").Value If h > 0 Then h2 = 1 Do Debug.Print Mid(c, h2, h) h2 = h2 + h Loop While h2 < Len(c) End If
こんなところですか
(作業員) 2022/06/28(火) 15:01(15:06修正)
Dim h As Long, h2 As Long h = Range("L44").Value If h > 0 Then h2 = 1 Do Debug.Print Mid(c, h2, h) h2 = h2 + h Loop While h2 < Len(c) End If
教えていただいたこれはどこに表示すれば実行できますでしょうか。
(Excel初心者) 2022/06/28(火) 15:14
Dim c As String Dim h As Long Dim iRow As Long Dim iColumn As Long Dim buf As Long Dim i As Long
c = Range("B44").Formula h = Range("L45").Value
If h > 0 Then For i = 1 To Len(c) Step h For iColumn = 1 To h buf = iRow * h + iColumn If buf > Len(c) Then Exit For Cells(iRow + 44, iColumn).Value = Mid(c, buf, 1) Next iRow = iRow + 1 Next End If
End Sub
参考までに
(作業員) 2022/06/28(火) 15:51
(Excel初心者) 2022/06/28(火) 16:21
Sub ボタン1() k = 45 '※未宣言変数(未使用) Dim c As String c = Range("B44").Formula Debug.Print (c) Dim h As Long 'Stringから変更 h = Range("L44").Value 'Formulaから変更 Debug.Print (h) j = 1 '※未宣言変数(未使用) Dim arr() As String Dim i As Long Dim leng As Long leng = Len(c) ReDim arr(leng - 1) For i = 0 To leng - 1 arr(i) = Mid(c, i + 1, 1) Next i Dim iRow As Long Dim iColumn As Long If h > 0 Then 'hが0のときエラーになるので回避 For i = 0 To leng - 1 iColumn = i Mod h iRow = Int(i / h) Range("A45").Offset(iRow, iColumn).Value = arr(i) Next i End If End Sub
元コードに追加する形に修正
(作業員) 2022/06/28(火) 16:28
付録です。(もう本題とほぼ関係なし^^;)
Function SplitChr(String1 As String) As Variant Rem 1キャラずつ配列に分解するだけの作業をわざわざ遠回りした結果とても動作が遅い関数 Rem (バイト配列にキャストするのが遅いのか巡回するのが遅いのか分からんがまぁとにかく遅い) If Len(String1) = 0 Then Exit Function Dim b() As Byte, i As Long, Ary() As String, j As Long Dim s As String, bt() As Byte, f As Boolean b = String1 ReDim Preserve Ary(0 To UBound(b)) For i = 0 To UBound(b) Step 2 If b(i + 1) >= &HD8& And b(i + 1) <= &HDB& Then f = True ReDim bt(0 To 3) bt(0) = b(i): bt(1) = b(i + 1) ElseIf f And b(i + 1) >= &HDC& And b(i + 1) <= &HDF& Then f = False bt(2) = b(i): bt(3) = b(i + 1): s = bt Ary(j) = s j = j + 1 Else f = False ReDim bt(0 To 1) bt(0) = b(i): bt(1) = b(i + 1): s = bt Ary(j) = s j = j + 1 End If Next ReDim Preserve Ary(0 To j - 1) SplitChr = Ary End Function
(白茶) 2022/06/28(火) 17:57
続きは、新しいスレ↑で。
Sub test() Dim r As Range Dim d As Object Dim s As String Dim 折り返し As Long Dim k As Long Dim w() As String, x As Long, y As Long
Set r = Range("A45:AC60") r.ClearContents
折り返し = Val(Range("L44").Value) '10 If 折り返し < 0 Then Exit Sub
s = Range("B44").Value '"Visual Basic for Appli cations" If s = "" Then Exit Sub
If MsgBox("表示しますか?", Buttons:=vbYesNo) = vbNo Then MsgBox "表示を中止しました" Exit Sub End If
ReDim w(1 To WorksheetFunction.RoundUp(Len(s) / 折り返し, 0), 1 To 折り返し)
For k = 1 To Len(s) If x = 折り返し Then x = 0 If x = 0 Then y = y + 1 x = x + 1 w(y, x) = Mid(s, k, 1) Next
r.Resize(y, 折り返し).Value = w
End Sub
(マナ) 2022/06/29(水) 18:43
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.