[µo°Ý] ¦³Ãölistbox °ÝÃD?

§ÚªÎ¤H

¦U¦ì°ª¤â¡AForm.xlsm¥»¨­¥i¥H¥¿±`¹B§@¡A¦ý²{¦bªí³æ»Ý¥[¤J§ó¦hÄæ¦ì(testbox1-9)¡A«KµLªk¨Ï¥Î¡A§Æ±æ°ª¤â«üÂI¡AÁÂÁÂ!!

Andy2483

¦^´_ 1# §ÚªÎ¤H


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç½m²ß°}¦C»P¦r¨å·f°t¿é¤Jµ¡ªº ·s¼W ¸ê®Æ§@·~ªº¸Ñ¨M¤è®×,½Ð«e½ú°Ñ¦Ò

°õ¦æ:

¤U¸ü (88.85 KB)

2023-3-3 15:06

Option Explicit
Sub ·s¼W()
Dim Brr, A, Y, i&, B As Range
Set Y = CreateObject("Scripting.Dictionary")
Brr = [A6:Q6]
For i = 1 To UBound(Brr, 2)
   A = InputBox(Brr(1, i), "½Ð¿é¤J", Cells(Rows.Count, i).End(3))
   If A = "//" Or StrPtr(A) = 0 Then Exit Sub Else: Y(Brr(1, i)) = A
Next
Set B = Cells(Rows.Count, 1).End(3).Item(2).Resize(1, Y.Count)
B.Value = Y.Items: Application.Goto B
End Sub

Andy2483

¦^´_ 1# §ÚªÎ¤H


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç½m²ß°}¦C¥H»²§Uªíªº¤è¦¡ °µ¸ê®Æ ­×§ï §@·~ªº¸Ñ¨M¤è®×,½Ð«e½ú°Ñ¦Ò

°õ¦æ¤è¦¡:
1.¿ï¨ú¸ê®Æªí¨ä¤¤¤@¦C©Î¤@®æ«á«ö­×§ï¶s:

¤U¸ü (92.27 KB)

2023-3-9 13:02

1.1.°õ¦æµ²ªG:

¤U¸ü (86.02 KB)

2023-3-9 13:05

2.­×§ï¸ê®Æ«á½Ð¤Á´«¦^¸ê®Æªí "Worksheet":

¤U¸ü (95.23 KB)

2023-3-9 13:07

3.§¹¦¨­×§ï:

¤U¸ü (92.5 KB)

2023-3-9 13:08

form_20230309_1.zip (40.77 KB)

¤U¸ü¦¸¼Æ: 7

2023-3-9 13:08

Option Explicit
Sub ½s¿è­×§ï¼Ò¦¡()
Dim Arr, Brr, R&
Application.DisplayAlerts = False
If Selection.Rows.Count > 1 Then MsgBox "¨C¦¸¥u¯à­×§ï¤@¦C¸ê®Æ": Exit Sub
If Selection.Row <= 6 Or Cells(Selection.Row, 1) = "" Then
   MsgBox "¥ý¿ï¨ú­×§ï¦C": Exit Sub
End If
R = Selection.Row: Arr = [A6:Q6]: Brr = Range(Cells(R, "A"), Cells(R, "Q"))
Rows(R).Font.ColorIndex = 1
On Error Resume Next
Sheets("Modify").Delete
On Error GoTo 0
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = "Modify"
[A2].Resize(UBound(Arr, 2), 1) = Application.Transpose(Arr)
[A2].Resize(UBound(Arr, 2), 1).Interior.ColorIndex = 35
[B2].Resize(UBound(Brr, 2), 1) = Application.Transpose(Brr)
[A1] = "¶µ¥Ø": [B1] = "­ì­È": [C1] = "·s­È"
Cells.Font.Size = 14
[A:B].EntireColumn.AutoFit
[C:C].ColumnWidth = [B:B].ColumnWidth * 2
ActiveSheet.UsedRange.Borders.LineStyle = xlContinuous
[D1] = R
ActiveSheet.Protection.AllowEditRanges.Add Title:="½d³ò1", Range:=[C2].Resize(UBound(Brr, 2), 1)
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="0000"
Sheets("Worksheet").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="0000"
End Sub
=============================================
Sub ­×§ï¸ê®Æ±a¤J¸ê®Æªí()
Dim Arr, R&, i&
If Sheets("Modify").Cells(Rows.Count, "C").End(3).Row = 1 Then MsgBox "¨S¦³­×§ï": Exit Sub
Arr = Sheets("Modify").UsedRange
R = Sheets("Modify").[D1]
For i = 2 To UBound(Arr)
   If Trim(Arr(i, 3)) <> "" Then
      Sheets("Worksheet").Cells(R, i - 1) = Trim(Arr(i, 3))
      Sheets("Worksheet").Cells(R, i - 1).Font.ColorIndex = 5
   End If
Next
End Sub
======================================
Private Sub Worksheet_Activate()
ActiveSheet.Unprotect "0000"
Call ­×§ï¸ê®Æ±a¤J¸ê®Æªí

Application.DisplayAlerts = False
Sheets("Modify").Delete
End Sub

Andy2483

¦^´_ 2# Andy2483


    ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç½Æ²ß¦¹©«¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub ·s¼W()
Dim Brr, A, Y, i&, B As Range
'¡ô«Å§iÅܼÆ:(Brr,A,Y)¬O³q¥Î«¬ÅܼÆ,i¬Oªø¾ã¼ÆÅܼÆ,B¬OÀx¦s®æÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Brr = [A6:Q6]
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C!¥H[A6:Q6]Àx¦s®æ­È±a¤J
For i = 1 To UBound(Brr, 2)
'¡ô³]¶¶°j°é!i±q1¨ì Brr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
   A = InputBox(Brr(1, i), "½Ð¿é¤J", Cells(Rows.Count, i).End(3))
   '¡ô¥OA³o³q¥Î«¬ÅܼƬO Application.InputBox ¤èªk¦^¶Ç¦r¦ê­È
   If A = "//" Or StrPtr(A) = 0 Then Exit Sub Else: Y(Brr(1, i)) = A
   '¡ô¦pªGAÅܼƬO "//",©ÎAÅܼƸgStrPtr¨ç¼Æ¦^¶Ç­È¬O 0!
   '´Nµ²§ôµ{¦¡°õ¦æ,§_«h¥O²Ä1¦Ci°j°éÄæBrr°}¦C­È¬°key,AÅܼƬOitem¯Ç¤JY¦r¨å
Next
Set B = Cells(Rows.Count, 1).End(3).Item(2).Resize(1, Y.Count)
'¡ô¥OB³oÀx¦s®æÅܼƬO(AÄæ³Ì«á¦³¤º®eÀx¦s®æªº¤U¤@­ÓÀx¦s®æ)ÂX®iÀx¦s®æ½d³ò,
'ÂX®iÀx¦s®æ½d³ò:¦V¥kY¦r¨åkey¼Æ¶qÄæ
B.Value = Y.Items: Application.Goto B
'¡ô¥OBÅܼƭȬO Y¦r¨åªºitem­È:¥OÀx¦s®æ´å¼Ð¿ï¨ú¦b BÅܼƤW
End Sub