zyzzyva

加個if 判斷？

1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
2. 
   
3. With Selection
   
4.     If .Interior.ColorIndex = 5 Then
   
5.         .Interior.ColorIndex = 3
   
6. 
   
7.     Else
   
8.         .Interior.ColorIndex = 5
   
9.         .Merge
   
10.         
    
11.     End If
    
12. End With
    
13. End Sub

複製代碼

zyzzyva

回復 8# 周大偉
自動換列是什麼意思？變色後換到下一列嗎？

zyzzyva

回復 10# 周大偉
不好意思，不是很了解這跟變色問題的關聯。如果只是要在vba中設定自動換列，使用.WrapText = True就可以了。

zyzzyva

回復 12# 周大偉
那是合併儲存格的問題，excel合併儲存格有很多問題，用vba設定wraptext也沒用(可以手動在目標列的下緣按兩下，會發現一樣無效)，詳細可以參考：
http://blog.contextures.com/archives/2015/12/03/autofit-merged-cells-row-height-update-20151203/
我想您應該是合併、變色完儲存格要在裡頭輸入文字？把下面的code加到同一個worksheet裡試試看。

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim Vhight As Single
   
3. If Target.WrapText = True Then
   
4. With Target
   
5. .Select
   
6. .RowHeight = 1
   
7. .WrapText = True
   
8. .UnMerge
   
9. .EntireRow.AutoFit
   
10. Selection.Merge
    
11. Vhight = .Width * .Height / Selection.Width
    
12. If Vhight < 16 Then Vhight = 16
    
13. .RowHeight = Vhight
    
14. .VerticalAlignment = xlCenter
    
15. End With
    
16. End If
    
17. End Sub

複製代碼

zyzzyva

回復 15# hong912
儲存格合併後不太好操作，請參考13F的回覆。

zyzzyva

回復 17# hong912
是2個事件，要放在同一個worksheet。按右鍵後會變色同時合併儲存格，如果在裡頭輸入，會有換列的效果(但不是很漂亮)。
個人覺得，如果會需要操作公式或程式，非必要盡量避免使用合併儲存格，儲存格合併之後，容易有很多奇奇怪怪的問題。

1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
2. 
   
3. With Selection
   
4.     If .Interior.ColorIndex = 5 Then
   
5.         .Interior.ColorIndex = 3
   
6. 
   
7.     Else
   
8.         .Interior.ColorIndex = 5
   
9.         .Merge
   
10.         .WrapText = True
    
11.         
    
12.     End If
    
13. End With
    
14. End Sub
    
15. 
    
16. 
    
17. Private Sub Worksheet_Change(ByVal Target As Range)
    
18. Dim Vhight As Single
    
19. If Target.WrapText = True Then
    
20. With Target
    
21. .Select
    
22. .RowHeight = 1
    
23. .WrapText = True
    
24. .UnMerge
    
25. .EntireRow.AutoFit
    
26. Selection.Merge
    
27. Vhight = .Width * .Height / Selection.Width
    
28. If Vhight < 16 Then Vhight = 16
    
29. .RowHeight = Vhight
    
30. .VerticalAlignment = xlCenter
    
31. End With
    
32. End If
    
33. End Sub

複製代碼

zyzzyva

回復 20# hong912
可以試著理解一下code，執行合併儲存格的是merge，只要把它刪除就可以了。
沒有合併的話，wraptext可以正常作用，另一個change事件也可以刪掉。

1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
2.     With Selection
   
3.         If .Interior.ColorIndex = 5 Then
   
4.             .Interior.ColorIndex = 3
   
5.         Else
   
6.             .Interior.ColorIndex = 5
   
7.             .WrapText = True
   
8.         End If
   
9.     End With
   
10. End Sub

複製代碼