[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力した文字を一文字ずつ表示したい』(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.