帖子: 9
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: window xp
軟體版本: 2003
閱讀權限: 10
性別: 男
註冊時間: 2010-7-27
最後登錄: 2014-2-5

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2010-7-27 20:47 | 只看該作者

[發問] 如何在A欄自動填上編號

如何在A欄自動填上編號，請各位高手指敎這程式碼如何寫? 謝謝!!
A欄       B欄
            1234
            23
            123

            234
            567

            123
            678
            4567
            185

完成後
A欄       B欄
1          1234
1          23
1          123

2          234
2          567

3          123
3          678
3          4567
3          185

樓主熱帖

basarasy

中學生 Rank: 2

帖子: 287
主題: 65
精華: 0
積分: 357
點名: 0
作業系統: xp
軟體版本: OFFIC 2007
閱讀權限: 20
註冊時間: 2010-6-4
最後登錄: 2015-8-19

2^#

發表於 2010-7-27 21:14 | 只看該作者

回復 1# aoss98

Sub Macro1()
'
' Macro1 Macro
MyBRow = 1
MyANo = 1
Range("B65536").Select
Selection.End(xlUp).Select
MyRow = Selection.Row
Do
If Range("B" & MyBRow).Value = "" Then
MyBRow = MyBRow + 1
MyANo = MyANo + 1
Else
Range("A" & MyBRow).Value = MyANo
MyBRow = MyBRow + 1
End If
Loop Until MyBRow = MyRow + 1
End Sub

複製代碼

我只會用一般的vba ><

50 字節以內
不支持自定義 Discuz! 代碼

TOP

luhpro

高中生 Rank: 3 Rank: 3

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

3^#

發表於 2010-7-27 21:27 | 只看該作者

Dim iI%, iNum%, bCheck As Boolean, bNext As Boolean

  iI = 0
  iNum = 1
  bNext = False
  bCheck = True

  With Sheets(1)
While bCheck
   iI = iI + 1
   If .Cells(iI, 2) <> "" Then
      .Cells(iI, 1) = iNum
      bNext = False
   Else
      If bNext = True Then
      bCheck = False
      Else
      iNum = iNum + 1
      bNext = True
      End If
   End If
Wend
  End With

單純針對每一個可能列出要做的事,
然後注意不要出現無限迴圈即可.

TOP

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

4^#

發表於 2010-7-27 21:43 | 只看該作者

這個不一定要用vba
假設開始在 A2 (即B2=1234)
在A2 輸個 1 (因為B2有東西)
在A3 輸這個公式 = IF(B3="", "", IF( A2="", A1+1 , A2 ))

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

aoss98

小學生 Rank: 1

帖子: 9
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: window xp
軟體版本: 2003
閱讀權限: 10
性別: 男
註冊時間: 2010-7-27
最後登錄: 2014-2-5

5^#

發表於 2010-7-27 21:45 | 只看該作者

謝謝 basarasy, luhpro 兩位指敎，問題已解決!!

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 101
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-5-2

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2010-7-27 22:22 | 只看該作者

回復 1# aoss98

Sub nn()
Set Rng = Range([B1], [B65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
For i = 1 To Rng.Areas.Count
Set a = Rng.Areas(i)
For Each b In a
b.Offset(, -1) = i
Next
Next
End Sub

複製代碼

學海無涯_不恥下問

TOP

aoss98

小學生 Rank: 1

帖子: 9
主題: 3
精華: 0
積分: 17
點名: 0
作業系統: window xp
軟體版本: 2003
閱讀權限: 10
性別: 男
註冊時間: 2010-7-27
最後登錄: 2014-2-5

7^#

發表於 2010-7-27 23:19 | 只看該作者

謝謝各位指教!!!

TOP

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

8^#

發表於 2010-7-29 00:12 | 只看該作者

本帖最後由 john2006168 於 2010-7-29 00:50 編輯

回復 aoss98
Hsieh 發表於 2010-7-27 22:22

tesst2010.zip (8.4 KB)
老師,我有類似的問題相同的問題,請問用VBA怎麼寫

tesst2010.zip (8.4 KB)

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 101
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-5-2

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

9^#

發表於 2010-7-29 00:24 | 只看該作者

回復 8# john2006168

Sub nn()
Dim Rng As Range
[A10].Insert xlToRight
[A10] = "plt no"
Set Rng = Range([A11], [A65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
For i = 1 To Rng.Areas.Count
mystr = Rng.Areas(i).Address
Rng.Areas(i).Insert xlToRight
Range(mystr).Value = i
Next
Range([A11], [A65536].End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub