[µo°Ý] ¸õ®æ²Ö¥[

johnny1680

Test 1-¸õ®æ²Ö¥[.rar (4.19 KB)

¤U¸ü¦¸¼Æ: 6

2021-10-18 21:40

·íA1¶ñ¤J¬Y¼Æ¦r¡AµM«á¨C¶¡¹j5¦C·|¦Û°Ê²Ö¥[10
¨Ò¦p¡GA1=100¡AµM«áA6=110¡AA11=120¡AA16=130¡AA21=140¡AA26=150¡A----¨ä¾lÃþ±À----¤U©Ô¨ìA101¡C
½Ð°Ý¡G¨ç¼Æ¤½¦¡­n«ç»ò½s¿è¡H
ÁÂÁ¡I

hcm19522

(¿é¤J½s¸¹12120) googleºô§}:https://hcm19522.blogspot.com/

singo1232001

Private Sub Worksheet_Change(ByVal Target As Range)
'¨¾¿ù«Ü¦n¥Î
If Target.Height > 10000000 Then Exit Sub  '¨¾¥þ¿ï·¸¦ì³ø¿ù
If Target.Width > 1000000 Then Exit Sub   '¨¾¥þ¿ï·¸¦ì³ø¿ù
If Target.Count > 1 Then Exit Sub      '¨¾¦h¿ï¦^·¹³ø¿ù
If Target.Value = "" Then Exit Sub    '¨¾ªÅ­È­pºâ³ø¿ù
If Target.Column > 1 Then Exit Sub
If Target.Row > 1 Then Exit Sub
If IsNumeric(Target.Value) = False Then Exit Sub  '¨¾«D¼Æ¦r­pºâ³ø¿ù

'¤G¤¸¤@¦¸Áp¥ß¤èµ{¦¡ (¥i§R°£µù¸Ñ)
'y = ax + b
'0= 1a + b     '1¦C=0
'10= 6a + b    '6¦C=10
'a = -b
'¥N¤J 10=-5b
'b=-2
'¥N¦^ 0=a-2
'a=2
'¨D¥X y=2x-2

ReDim ar(1 To 101, 0)
For i = 1 To 101 Step 5
ar(i, 0) = i * 2 - 2 + Target.Value   '¥N¤J¤½¦¡y=2x-2 +­ì©l­È
Next
Target.Resize(101, 1) = ar
End Sub

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßDo Until Loop,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:

¤U¸ü (22.92 KB)

2023-12-11 08:59

°õ¦æµ²ªG:

¤U¸ü (26.17 KB)

2023-12-11 08:59

¤@¯ë¼Ò²Õ:
Option Explicit
Sub TEST()
Dim Y%, R%, xR As Range
Set xR = [A1]
Do Until R >= 101
   Y = Y + 1
   R = Y * 5 + 1
   xR(R) = Val(xR) + 10 * Y
Loop
End Sub

¤u§@ªí¼Ò²Õ:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "A1" Then Call TEST
End Sub

johnny1680

¦^´_ 3# samwang
¦^´_ 4# hcm19522

·PÁ¤G¦ì¤j¤jªºÀ°¦£!

hcm19522

https://blog.xuite.net/hcm19522/twblog/590079887

samwang

¦^´_ 1# johnny1680

²¤Æ#2¡AÁÂÁÂ
Sub test2()
Dim Arr, xD
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("a1:a101")
For i = 6 To UBound(Arr) Step 5
    If xD.Exists(Arr(1, 1)) Then
        Arr(i, 1) = xD(Arr(1, 1)) + 10
        xD(Arr(1, 1)) = Arr(i, 1)
    Else
        Arr(i, 1) = Arr(1, 1) + 10
        xD(Arr(1, 1)) = Arr(i, 1)
    End If
Next
Range("a1").Resize(UBound(Arr), 1) = Arr
End Sub

samwang

¦^´_ 1# johnny1680


Sub test()
Dim R As Range, xD, n%
Set xD = CreateObject("Scripting.Dictionary")
For Each R In Range("a2:a101")
    n = n + 1
    If n = 5 Then
        If xD.exists(Cells(1, 1).Value) Then
        R.Value = xD(Cells(1, 1).Value) + 10
        xD(Cells(1, 1).Value) = R: n = 0
        Else
        R.Value = Cells(1, 1) + 10
        xD(Cells(1, 1).Value) = R: n = 0
        End If
    End If
Next
End Sub