Sub test_Click1()
Dim gyo As Long, rnd1 As Long
Dim sss As String, ttt As String
Dim CellA As Range
With ThisWorkbook.Sheets("Sheet1")
.Range("A:A").Copy .Range("C1")
gyo = .Range("B" & Rows.Count).End(xlUp).Row
For Each CellA In .Range("C1:C" & .Range("C" & .Rows.Count).End(xlUp).Row)
sss = ""
Do Until InStr(CellA.Value, "(置換する所)") = 0
Do '重複チェック
rnd1 = Int(Rnd() * gyo) + 1
ttt = .Range("B" & rnd1).Value
If InStr(sss, ttt) = 0 Then
sss = sss & "," & ttt
Exit Do
End If
Loop
CellA.Value = Replace(CellA.Value, "(置換する所)", ttt, , 1)
Loop
Next CellA
End With
End Sub
No2です。
No2の内容は特に問題にならなければ。
Sub try()
Dim r As Range
Dim st1 As String
Dim st2 As String
Dim st As String
Dim i As Integer
Dim m As Long
Dim v As Variant
For Each r In Range("A1", Cells(Rows.C
...続きを読む
No2です。
No2の内容は特に問題にならなければ。
Sub try()
Dim r As Range
Dim st1 As String
Dim st2 As String
Dim st As String
Dim i As Integer
Dim m As Long
Dim v As Variant
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp))
v = Split(r.Value, "(置換する所)")
Randomize
st = ""
st2 = ""
For i = 0 To UBound(v) - 1
Do
m = Int(Rnd() * Cells(Rows.Count, 2).End(xlUp).Row) + 1
st1 = Range("B" & m).Value
Loop Until InStr(st2, st1) = 0
st2 = st2 & st1 & ","
No3です。
1万行はどうかわかりませんが。
Private vv As Variant
Private ch As Boolean
Sub try1()
Dim r As Range
Dim st1 As String
Dim st2 As String
Dim st As String
Dim i As Integer
Dim m As Long
Dim v As Variant
vv = R
...続きを読む
No3です。
1万行はどうかわかりませんが。
Private vv As Variant
Private ch As Boolean
Sub try1()
Dim r As Range
Dim st1 As String
Dim st2 As String
Dim st As String
Dim i As Integer
Dim m As Long
Dim v As Variant
No5です。
まずtry1とtry2用に2つのボタンを配置します。
try1 が Sub test_Click()~End Sub
try2 が Sub reset_Click()~End Sub
みたいしにして、それぞれに中のコードをコピペします。
あとは Sub test_Click() の上に
Private vv As Variant
Private ch As Boolean
をコピ
...続きを読む
No5です。
まずtry1とtry2用に2つのボタンを配置します。
try1 が Sub test_Click()~End Sub
try2 が Sub reset_Click()~End Sub
'//
Sub TestReplace()
'Private Sub CommandButton1_Click()
Const sFND As String = "(" '置換対象の検索する文字(1文字)
Dim rng As Range
Dim i As Long, j As Long, k As Long, m As Long
Dim Ar As Variant
Dim arRnd() As Long '乱数を入れる
Dim LastCnt As Long
Dim newSht As Worksheet, ACsht As Worksheet, dum As Variant
'A列
Set ACsht = ActiveSheet
Set rng = ACsht.Range("A1", Cells(Rows.Count, 1).End(xlUp))
On Error Resume Next
dum = Worksheets("Backup").Range("A1").Value
If Err.Number > 0 Then
With ActiveWorkbook
Set newSht = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
newSht.Name = "Backup"
ACsht.Activate
End With
End If
If dum <> "" Then
newSht.Range("A1").CurrentRegion.Clear
End If
rng.Copy newSht.Range("A1")
On Error GoTo 0
With ACsht
LastCnt = .Cells(Rows.Count, 1).End(xlUp).Row
'B列
Ar = Application.Transpose(.Range("B1", .Cells(Rows.Count, 2).End(xlUp)).Value)
m = UBound(Ar) '最終行
ReDim arRnd(m - 1)
Application.ScreenUpdating = False
Randomize '←乱数プレートは1回に1回の交換
For i = 1 To LastCnt
j = Len(.Cells(i, 1).Value) - Len(Replace(.Cells(i, 1).Value, sFND, "", , , 1))
RngMaking arRnd, j
For k = 1 To j
.Cells(i, 1).Value = Replace(.Cells(i, 1).Value, "(置換する所)", Ar(arRnd(k) + 1), , 1, 1)
Next k
Next i
Application.ScreenUpdating = True
End With
End Sub
Sub RngMaking(arRnd() As Long, ByVal cut As Integer)
'乱数生成
Dim LastCnt As Long
Dim i As Long, k As Long, n As Long
Dim Ret As Variant
LastCnt = UBound(arRnd)
ReDim arRnd(LastCnt)
Do
n = Int(Rnd() * LastCnt) + 1
Ret = Application.Match(n, arRnd, 0)
If IsError(Ret) Then
arRnd(i) = n
If (i + 1) >= cut Then Exit Sub '乱数の収得の中止
i = i + 1
End If
'ハング防止
k = k + 1: If k > LastCnt ^ 4 Then MsgBox "Unknown Error", 36: End
Loop Until i > LastCnt - 1
End Sub
Sub DataBack()
'データ戻し
Worksheets("Backup").Range("A1").CurrentRegion.Resize(, 1).Copy _
ActiveSheet.Range("A1")
End Sub
ちょっと手抜きプログラムですが、
ランダムで、前のものと同じにならない様にするには、以下の様にされてはどうでしょうか?
Sub test_Click()
For Each CellA In Range("A1:A5").Cells
Rnd1 = Int(Rnd() * 10) + 1
Do
Rnd2 = Int(Rnd() * 10) + 1
Loop Until Rnd1 <
...続きを読む
Sub test_Click()
For Each CellA In Range("A1:A5").Cells
Rnd1 = Int(Rnd() * 10) + 1
Do
Rnd2 = Int(Rnd() * 10) + 1
Loop Until Rnd1 <> Rnd2
Do
Rnd3 = Int(Rnd() * 10) + 1
Loop Until (Rnd1 <> Rnd3 And Rnd2 <> Rnd3)
Do
Rnd4 = Int(Rnd() * 10) + 1
Loop Until (Rnd1 <> Rnd4 And Rnd2 <> Rnd4 And Rnd3 <> Rnd4)
Do
Rnd5 = Int(Rnd() * 10) + 1
Loop Until (Rnd1 <> Rnd5 And Rnd2 <> Rnd5 And Rnd3 <> Rnd5 And Rnd4 <> Rnd5)
Do
Rnd6 = Int(Rnd() * 10) + 1
Loop Until (Rnd1 <> Rnd6 And Rnd2 <> Rnd6 And Rnd3 <> Rnd6 And Rnd4 <> Rnd6 And Rnd5 <> Rnd6)
あなたの思ったこと、知っていることをここにコメントしてみましょう。